# Function to compute divergence similarity
divergence <- function(behave_data){

  divergence_df <- data.frame()

  sample_max <- max(behave_data)

  for (i in 1:length(behave_data)){
    for (j in 1:length(behave_data)){

      pair_vec <- c(behave_data[[i]], behave_data[[j]])
      output_conv <- mean(pair_vec)
      divergence_df[i, j] <- (sample_max - output_conv)

    }}

  return(divergence_df)
}

make_similarity_matrices <- function(behave_vec,
                                     index,
                                     center_value_list,
                                     center_value_name_list,
                                     resultpath,
                                     save_out){

  dataframes2loopthrough <- list()

  behave_nn <- nearest_neighbours(behave_vec) # absolute difference
  nn_name <- "behave_nn"
  behave_conv <- convergence(behave_vec) # minimum pair
  conv_name <- "behave_conv"
  behave_div <- divergence(behave_vec) # max(sample) - minimum pair
  div_name <- "behave_div"

  df_names_finn <- c(nn_name, conv_name, div_name)

  df_names_behave <- c()
  df_names_punctuated <- c()
  
  for (i in 1:length(center_value_list)){
    behave_bow <- bow_tie(behave_vec, center_value_list[i]) # see function
    behave_punct <- punctuated(behave_vec, center_value_list[i]) # see function

    df_name <- paste0('punctuacted_', center_value_name_list[i])
    df_names_behave[i] <- df_name
    
    df_name_punct <- paste0('punctuated_nn_', center_value_name_list[i])
    df_names_punctuated[i] <- df_name_punct

    assign(df_name, behave_bow)
    assign(df_name_punct, behave_punct)
  }

  df_names <- c(df_names_finn, df_names_behave, df_names_punctuated)

  dataframes2loopthrough <- do.call("list", mget(df_names))

  for (df in 1:length(dataframes2loopthrough)){

    df2use <- dataframes2loopthrough[[df]]

    dfname <- names(dataframes2loopthrough)

    final_df <- scale_matrix(df2use)

    # replace diagonal values with 1
    diag(final_df) <- round(1, digits = 0)
    rownames(final_df) <- index

    assign(dfname[df], final_df)

    saveoutfilepath <- file.path(resultpath,
                                 paste0(dfname[df], ".csv"))

    if(save_out == TRUE){
      write.csv(final_df, saveoutfilepath, row.names=FALSE)}

  }

  final_dataframes2loopthrough <- do.call("list", mget(df_names))
  
  return(final_dataframes2loopthrough)

} # end function run behave model similarity


# compute similarity on single value output

compute_single_variable_similarity <- function(single_v_data, 
                                               subids,
                                               name2use,
                                               resultpath,
                                               save_out){
  
  matrix_similarity = data.frame()
  
  for (i in 1:length(single_v_data)){
    for (j in 1:length(single_v_data)){
      
      data_i = single_v_data[[i]]
      data_j = single_v_data[[j]]
      
      abs_diff = abs(data_i - data_j)
      
      matrix_similarity[i, j] = abs_diff
      
    }}
      
  matrix_scaled = 1 - scale_matrix(matrix_similarity)
  
  rownames(matrix_scaled) = subids
  colnames(matrix_scaled) = subids
  
  saveoutfilename <- paste0(name2use, ".csv")
  saveoutfilepath <- file.path(resultpath, 
                                saveoutfilename)
  
  if (save_out == TRUE){
    write.csv(matrix_scaled, saveoutfilepath, row.names=FALSE)}
  
  return(as.matrix(matrix_scaled))
}

mantel_results_models <- function(x, y, nperm, n_models){
  
  # function takes two separate lists of dataframes as arguments
  # where x = list of data frames that model behavioral similarity (4 models)
  # and y = list of data frames that model dependent variable similarity
  # nperm is the n of permutations you want to run (i.e. 1000)
  # n_models is the number of behavioral models you are using FIX ME
  
  # using package vegan for the mantel() function, with spearman method*
  # *because distribution of similarity is not parametric 
  # cit. https://jkzorz.github.io/2019/07/08/mantel-test.html
  
  # NB: switched to the vegan package, because the metan one was defaulting into spearman and there was no way to edit that (we need a non-parametric test)
  
  n_comparisons = length(y)

  len_final_df = n_models*n_comparisons

  model_res_r <- data.frame()
  model_res_p <- data.frame()
  rownames_df <- data.frame()

  modelname = names(x)
  comparisonname = names(y)

  for (i in 1:length(x)){
    for (j in 1:length(y)){

        result_name <- paste0(modelname[i], comparisonname[j])

        model2use = x[[i]]
        data2use = y[[j]]

        model_out = mantel(model2use,
                           data2use,
                           method = "spearman",
                           permutations = nperm,
                           na.rm = TRUE)

        model_res_r <- rbind(model_res_r, 
                             model_out$statistic) # r-value
        model_res_p <- rbind(model_res_p, 
                             model_out$signif) # p-value

        rownames_df <- rbind(rownames_df, result_name)
    }}

  colnames(model_res_r) <- "r"
  colnames(model_res_p) <- "p_value"

  model_res <- cbind(model_res_p, model_res_r)
  rownames(model_res) <- rownames_df[[1]]

  model_res$p_value_adjusted <- p.adjust(model_res$p_value,
                                         method = "fdr")

  return(model_res)

} # end function mantel_results_models


compare_correlations <- function(r1_value,
                                 r2_value,
                                 alpha_level,
                                 n_1,
                                 n_2){
  
  # NB: applies to BOTH Pearson or Spearman's
  
  # REFs
  # https://blogs.sas.com/content/iml/2017/09/20/fishers-transformation-correlation.html
  # https://www.medcalc.org/manual/comparison-of-correlation-coefficients.php
  # Fisher (1925): http://krishikosh.egranth.ac.in/bitstream/1/2048218/1/0039_2689A.pdf
  # p_value from z score: https://www.r-bloggers.com/2022/05/calculate-the-p-value-from-z-score-in-r/
  
  # as a test case I used the exact values in the Medcalc link
  # and I got the same results 
  
  result_names <- c("r_values",
                    "z_scores",
                    "standard_error",
                    "Fisher's z",
                    "p_value",
                    "significance")
  result <- vector("list", length(result_names))
  names(result) <- result_names
  
  # save the original r values
  result[["r_values"]] <- c("r1" = r1_value, "r2" = r2_value)
  
  # calculate z scores for the two pearson r coefficients
  z1_value <- (1/2)*log((1+r1_value)/(1-r1_value)) 
  z2_value <- (1/2)*log((1+r2_value)/(1-r2_value)) 
  result[["z_scores"]] <- c("z1" = z1_value, "z2" = z2_value)
  
  # calculate the standard error based on sample size
  se_value1 <- (1/(n_1 - 3))
  se_value2 <- (1/(n_2 - 3))
  
  standard_error <- sqrt(se_value1 + se_value2)
  result[["standard_error"]] <- standard_error
  
  # compute Fisher's z
  # NB: we need to take the absolute value because this 
  # eliminates the effect of which correlation is 
  # first and which is second
  
  z <- abs((z1_value - z2_value)/standard_error)
  result[["Fisher's z"]] <- z
  
  # test significance of Fisher's z (rounded to 4 decimal places)
  # need to see the lower.tail to FALSE as we are only 
  # evaluating positive z scores 
  p_value <- pnorm(z, lower.tail = FALSE)
  p_value_formatted <- format(round(p_value, 4), nsmall = 4)
  
  significant <- ifelse(p_value > alpha_level, "No", "Yes")
  
  result[["p_value"]] <- p_value_formatted 
  result[["significance"]] <- significant
  
  return(result)
}
library(easypackages)

libraries("here",
          "ggplot2",
          "tidyverse", 
          "psych", 
          "reticulate",
          "graph4lg", 
          "ade4", 
          "vegan",
          "similaritymodels",
          "caret",
          "tidyverse",
          "robustbase",
          "egg",
          "reshape2",
          "knitr",
          "kableExtra",
          "quantmod")
## Loading required package: here
## here() starts at /Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof
## Loading required package: ggplot2
## Loading required package: tidyverse
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.4     ✔ tibble    3.2.1
## ✔ purrr     1.0.4     ✔ tidyr     1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Loading required package: psych
## 
## 
## Attaching package: 'psych'
## 
## 
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## 
## 
## Loading required package: reticulate
## 
## Loading required package: graph4lg
## 
## Welcome to 'graph4lg' package. Let's do landscape genetics analysis with graphs
## 
## Loading required package: ade4
## 
## Loading required package: vegan
## 
## Loading required package: permute
## 
## Loading required package: lattice
## 
## 
## Attaching package: 'vegan'
## 
## 
## The following object is masked from 'package:psych':
## 
##     pca
## 
## 
## Loading required package: similaritymodels
## 
## 
## Attaching package: 'similaritymodels'
## 
## 
## The following objects are masked _by_ '.GlobalEnv':
## 
##     divergence, make_similarity_matrices
## 
## 
## Loading required package: caret
## 
## 
## Attaching package: 'caret'
## 
## 
## The following object is masked from 'package:vegan':
## 
##     tolerance
## 
## 
## The following object is masked from 'package:purrr':
## 
##     lift
## 
## 
## Loading required package: robustbase
## 
## Loading required package: egg
## 
## Loading required package: gridExtra
## 
## 
## Attaching package: 'gridExtra'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     combine
## 
## 
## Loading required package: reshape2
## 
## 
## Attaching package: 'reshape2'
## 
## 
## The following object is masked from 'package:tidyr':
## 
##     smiths
## 
## 
## Loading required package: knitr
## 
## Loading required package: kableExtra
## 
## 
## Attaching package: 'kableExtra'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     group_rows
## 
## 
## Loading required package: quantmod
## 
## Loading required package: xts
## 
## Loading required package: zoo
## 
## 
## Attaching package: 'zoo'
## 
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## 
## Attaching package: 'xts'
## 
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## 
## Loading required package: TTR
## 
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo 
## 
## All packages loaded successfully
codepath = here("code")
resultpath = here("results")
datapath = here("data")
plotpath = here("plots")

# set random seed
set.seed(999)

# choose alpha (hypothesis testing sig. threshold)
alpha <- 0.05

# create list of tickers from US, UK, and German stock markets
# TICKER LIST AND RELATED COUNTRY
#
# FTSE: UK (FTSE 1000)
# GSPC: USA (S&P 500)
# GDAXI: Germany (GDAXI) 
# FTSEMIB: Italy
# FCHI: France
# AXJO: Australia
# HSI: Hong Kong

# REF: https://www.sciencedirect.com/science/article/pii/S2405844024012337

ticker_list <- c("^FTSE", "^GSPC", "^GDAXI", "FTSEMIB.MI", "^FCHI", "^AXJO", "^HSI")

# Covid lockdown dates
#
# UK LEGAL COVID MANDATE (23/03/2020): 
# https://www.instituteforgovernment.org.uk/sites/default/files/timeline-lockdown-web.pdf
# US BORDER CLOSER MANDATE (16/03/2020): https://www150.statcan.gc.ca/n1/pub/45-28-0001/2021001/article/00007-eng.htm
# GERMAN LEGAL COVID MANDATE (25/03/202):https://www.deutsche-apotheker-zeitung.de/news/artikel/2020/03/25/bundestag-stellt-epidemische-lage-von-nationaler-tragweite-fest
# ITALY COVID MANDATE (09/03/2020): https://en.wikipedia.org/wiki/COVID-19_lockdowns_in_Italy
# FRANCE COVID MANDATE (17/03/2020): https://www.france24.com/en/france/20210317-in-pictures-a-look-back-one-year-after-france-went-into-lockdown
# AUSTRALIA border closer (19/03/2020): https://www.timeout.com/melbourne/things-to-do/a-timeline-of-covid-19-in-australia-two-years-on
# WHO DECLARES PANDEMIC (11/03/2020): https://pmc.ncbi.nlm.nih.gov/articles/PMC7569573/
# CHINA declares SARS-CoV-2 sequence (12/01/2020): https://pmc.ncbi.nlm.nih.gov/articles/PMC7068164

# KEY dates to use:
#
# China declaration (early Jan 2020) (adding a day as the real date, 12th, is Sunday)
# WHO pandemic declaration (early March 2020)
# USA close borders (mid-march 2020)

lockdown_dates_strings <- c("2020-01-13", "2020-03-11", "2020-03-16")
center_value_name_list <- c("china", "who", "usa")

# n of age similarity models we will build
n_behave_models = 9

# number of permutations
nperm = 1000

# make plots pretty

#https://stackoverflow.com/questions/6736378/how-do-i-change-the-background-color-of-a-plot-made-with-ggplot2
mytheme <- list(
  theme_classic()+
    theme(panel.background = element_blank(),strip.background = element_rect(colour=NA, fill=NA),panel.border = element_rect(fill = NA, color = "black"),
          legend.title = element_blank(),legend.position="bottom", strip.text = element_text(face="bold", size=9),
          axis.text=element_text(face="bold"),axis.title = element_text(face="bold"),plot.title = element_text(face = "bold", hjust = 0.5,size=13))
)
# get data 
# NB: the 1st of september 2019 was a sunday so starting on the 2nd

dates2use <- list()
indices2use <- list()
vals2use <- list()

for (ticker in ticker_list){
  
  ticker_clean <- gsub("\\^", "", ticker)
  df_name <- paste0(ticker_clean, "_df")
  getSymbols(ticker, src="yahoo", from="2019-09-02", to ="2020-09-02")
  df2use <- data.frame(get(ticker_clean))
  df2use <- df2use[complete.cases(df2use), ]
  assign(df_name, df2use)
  
  # get change in time as distance in days from time 0 (02/09/2019)
  dates_raw <- as.Date(gsub("-", "", rownames(df2use)), format = "%Y%m%d")
  dates <- as.numeric(dates_raw - min(dates_raw))
  
  # save dates to list
  dates_name <- paste0(ticker_clean, "_dates")
  dates2use[[dates_name]] <- dates
  
  # get string dates as 'subject' ids (index column)
  index2use <- rownames(df2use)
  
  # save index to list
  index_name <- paste0(ticker_clean, "_index")
  indices2use[[index_name]] <- index2use
  
  # get the corresponding indices for the pivotal dates we want to measure against
  center_value <- c()
  i = 1
  for (date in lockdown_dates_strings){
    get_date_index <- which(index2use == date)
    center_value[i] <- dates[get_date_index]
    i <- i + 1
  }
  
  # store out the corresponding times (n days from time point 0)
  center_name <- paste0(ticker_clean, "_center")
  vals2use[[center_name]] <- center_value
  
  # check lengths of dfs (unless missing data should be of mostly equal length)
  print(paste0("Number of dates in ", ticker_clean, ": ", nrow(df2use)))
}
## [1] "Number of dates in FTSE: 254"
## [1] "Number of dates in GSPC: 253"
## [1] "Number of dates in GDAXI: 252"
## [1] "Number of dates in FTSEMIB.MI: 253"
## [1] "Number of dates in FCHI: 256"
## [1] "Number of dates in AXJO: 255"
## [1] "Number of dates in HSI: 249"
# NOT IN A LOOP SO I CAN SEE TICKER ON GRAPHS
# REF: https://stat-wizards.github.io/Forcasting-A-Time-Series-Stock-Market-Data/
print(chartSeries(FTSE, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = FTSE, TA = NULL)
## 
## Slot "xdata":
##            FTSE.Open FTSE.High FTSE.Low FTSE.Close FTSE.Volume FTSE.Adjusted
## 2019-09-02    7207.2    7315.3   7206.9     7281.9   497764900        7281.9
## 2019-09-03    7281.9    7301.5   7239.1     7268.2   626095300        7268.2
## 2019-09-04    7268.2    7334.6   7268.2     7311.3   677444300        7311.3
## 2019-09-05    7311.3    7330.7   7250.6     7271.2   711302800        7271.2
## 2019-09-06    7271.2    7284.1   7244.1     7282.3   692287900        7282.3
## 2019-09-09    7282.3    7325.2   7206.0     7235.8   794831900        7235.8
## 2019-09-10    7235.8    7270.5   7199.4     7268.0  1031549500        7268.0
## 2019-09-11    7268.0    7346.7   7268.0     7338.0   829121400        7338.0
## 2019-09-12    7338.0    7369.3   7303.2     7344.7   725259800        7344.7
## 2019-09-13    7344.7    7380.3   7318.2     7367.5  1003827600        7367.5
##        ...                                                                  
## 2020-08-18    6127.4    6162.7   6062.6     6076.6   502242600        6076.6
## 2020-08-19    6076.6    6114.8   6045.0     6112.0   425040900        6112.0
## 2020-08-20    6112.0    6112.0   6009.6     6013.3   505170900        6013.3
## 2020-08-21    6013.3    6036.5   5948.8     6001.9   545211700        6001.9
## 2020-08-24    6001.9    6119.8   6001.9     6104.7   452722200        6104.7
## 2020-08-25    6104.7    6173.5   6032.1     6037.0   538992400        6037.0
## 2020-08-26    6037.0    6050.8   5992.2     6045.6   405657200        6045.6
## 2020-08-27    6045.6    6062.5   6000.0     6000.0   496427000        6000.0
## 2020-08-28    6000.0    6033.0   5962.5     5963.6   928308900        5963.6
## 2020-09-01    5963.6    5972.5   5824.0     5862.1  1041226100        5862.1
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253 254
## 
## Slot "name":
## [1] "FTSE"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## FTSE
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 254
## 
## Slot "yrange":
## [1] 4898.8 7689.7
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 254
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 02\n2019 Oct 01\n2019 Nov 01\n2019 Dec 02\n2019 Jan 02\n2020 Feb 03\n2020 
##            1           22           45           66           86          108 
## Mar 02\n2020 Apr 01\n2020 May 01\n2020 Jun 01\n2020 Jul 01\n2020 Aug 03\n2020 
##          128          150          170          189          211          234 
## Sep 01\n2020 Sep 01\n2020 
##          254          254 
## 
## Slot "x.labels":
##  [1] "Sep 02\n2019" "Oct 01\n2019" "Nov 01\n2019" "Dec 02\n2019" "Jan 02\n2020"
##  [6] "Feb 03\n2020" "Mar 02\n2020" "Apr 01\n2020" "May 01\n2020" "Jun 01\n2020"
## [11] "Jul 01\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 01\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
print(chartSeries(GSPC, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = GSPC, TA = NULL)
## 
## Slot "xdata":
##            GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 2019-09-03   2909.01   2914.39  2891.85    2906.27  3427830000       2906.27
## 2019-09-04   2924.67   2938.84  2921.86    2937.78  3167900000       2937.78
## 2019-09-05   2960.60   2985.86  2960.60    2976.00  3902600000       2976.00
## 2019-09-06   2980.33   2985.03  2972.51    2978.71  3209340000       2978.71
## 2019-09-09   2988.43   2989.43  2969.39    2978.43  4031120000       2978.43
## 2019-09-10   2971.01   2979.39  2957.01    2979.39  4393040000       2979.39
## 2019-09-11   2981.41   3000.93  2975.31    3000.93  3934370000       3000.93
## 2019-09-12   3009.08   3020.74  3000.92    3009.57  3796990000       3009.57
## 2019-09-13   3012.21   3017.33  3002.90    3007.39  3557010000       3007.39
## 2019-09-16   2996.41   3002.19  2990.67    2997.96  4285860000       2997.96
##        ...                                                                  
## 2020-08-19   3392.51   3399.54  3369.66    3374.85  3679480000       3374.85
## 2020-08-20   3360.48   3390.80  3354.69    3385.51  3431040000       3385.51
## 2020-08-21   3386.01   3399.96  3379.31    3397.16  3505010000       3397.16
## 2020-08-24   3418.09   3432.09  3413.13    3431.28  3743410000       3431.28
## 2020-08-25   3435.95   3444.21  3425.84    3443.62  3627650000       3443.62
## 2020-08-26   3449.97   3481.07  3444.15    3478.73  3780530000       3478.73
## 2020-08-27   3485.14   3501.38  3468.35    3484.55  3955890000       3484.55
## 2020-08-28   3494.69   3509.23  3484.32    3508.01  3868510000       3508.01
## 2020-08-31   3509.73   3514.77  3493.25    3500.31  4348280000       3500.31
## 2020-09-01   3507.44   3528.03  3494.60    3526.65  4101490000       3526.65
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253
## 
## Slot "name":
## [1] "GSPC"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## GSPC
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 253
## 
## Slot "yrange":
## [1] 2191.86 3528.03
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 253
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 03\n2019 Oct 01\n2019 Nov 01\n2019 Dec 02\n2019 Jan 02\n2020 Feb 03\n2020 
##            1           21           44           64           85          106 
## Mar 02\n2020 Apr 01\n2020 May 01\n2020 Jun 01\n2020 Jul 01\n2020 Aug 03\n2020 
##          125          147          168          188          210          232 
## Sep 01\n2020 Sep 01\n2020 
##          253          253 
## 
## Slot "x.labels":
##  [1] "Sep 03\n2019" "Oct 01\n2019" "Nov 01\n2019" "Dec 02\n2019" "Jan 02\n2020"
##  [6] "Feb 03\n2020" "Mar 02\n2020" "Apr 01\n2020" "May 01\n2020" "Jun 01\n2020"
## [11] "Jul 01\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 01\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
print(chartSeries(GDAXI, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = GDAXI, TA = NULL)
## 
## Slot "xdata":
##            GDAXI.Open GDAXI.High GDAXI.Low GDAXI.Close GDAXI.Volume
## 2019-09-02   11939.99   11994.11  11929.91    11953.78     46207600
## 2019-09-03   11921.94   11956.69  11869.28    11910.86     66704200
## 2019-09-04   12043.96   12078.40  11999.83    12025.04     63323800
## 2019-09-05   12117.90   12151.31  12084.17    12126.78     89831600
## 2019-09-06   12146.00   12205.10  12131.29    12191.73     80411000
## 2019-09-09   12210.87   12245.11  12189.60    12226.10     74246100
## 2019-09-10   12210.88   12292.14  12179.88    12268.71    107899800
## 2019-09-11   12341.84   12394.28  12317.61    12359.07     90579200
## 2019-09-12   12399.40   12471.83  12311.81    12410.25    111214300
## 2019-09-13   12412.72   12494.25  12408.93    12468.53     90990500
##        ...                                                         
## 2020-08-19   12838.63   12980.70  12833.80    12977.33     52633400
## 2020-08-20   12829.39   12891.14  12755.52    12830.00     54738500
## 2020-08-21   12879.45   12911.27  12633.71    12764.80     71999900
## 2020-08-24   12945.97   13104.31  12924.70    13066.54     64175000
## 2020-08-25   13136.77   13221.82  13060.87    13061.62     55974200
## 2020-08-26   13041.83   13192.32  13010.53    13190.15     46701500
## 2020-08-27   13206.58   13218.05  13087.37    13096.36     53031400
## 2020-08-28   13140.60   13147.24  12951.26    13033.20     63768900
## 2020-08-31   13103.93   13148.19  12923.76    12945.38     59561900
## 2020-09-01   13037.20   13127.28  12850.30    12974.25     63053900
##            GDAXI.Adjusted
## 2019-09-02       11953.78
## 2019-09-03       11910.86
## 2019-09-04       12025.04
## 2019-09-05       12126.78
## 2019-09-06       12191.73
## 2019-09-09       12226.10
## 2019-09-10       12268.71
## 2019-09-11       12359.07
## 2019-09-12       12410.25
## 2019-09-13       12468.53
##        ...               
## 2020-08-19       12977.33
## 2020-08-20       12830.00
## 2020-08-21       12764.80
## 2020-08-24       13066.54
## 2020-08-25       13061.62
## 2020-08-26       13190.15
## 2020-08-27       13096.36
## 2020-08-28       13033.20
## 2020-08-31       12945.38
## 2020-09-01       12974.25
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## 
## Slot "name":
## [1] "GDAXI"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## GDAXI
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 252
## 
## Slot "yrange":
## [1]  8255.65 13795.24
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 252
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 02\n2019 Oct 01\n2019 Nov 01\n2019 Dec 02\n2019 Jan 02\n2020 Feb 03\n2020 
##            1           22           44           65           83          105 
## Mar 02\n2020 Apr 01\n2020 May 04\n2020 Jun 02\n2020 Jul 01\n2020 Aug 03\n2020 
##          125          147          167          187          208          231 
## Sep 01\n2020 Sep 01\n2020 
##          252          252 
## 
## Slot "x.labels":
##  [1] "Sep 02\n2019" "Oct 01\n2019" "Nov 01\n2019" "Dec 02\n2019" "Jan 02\n2020"
##  [6] "Feb 03\n2020" "Mar 02\n2020" "Apr 01\n2020" "May 04\n2020" "Jun 02\n2020"
## [11] "Jul 01\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 01\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
print(chartSeries(FTSEMIB.MI, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = FTSEMIB.MI, TA = NULL)
## 
## Slot "xdata":
##            FTSEMIB.MI.Open FTSEMIB.MI.High FTSEMIB.MI.Low FTSEMIB.MI.Close
## 2019-09-02           21390           21567          21389            21452
## 2019-09-03           21438           21497          21311            21399
## 2019-09-04           21665           21777          21630            21738
## 2019-09-05           21853           21955          21796            21955
## 2019-09-06           21967           22010          21857            21947
## 2019-09-09           22008           22041          21935            21990
## 2019-09-10           21964           21989          21824            21869
## 2019-09-11           21994           22033          21796            21892
## 2019-09-12           21983           22141          21835            22083
## 2019-09-13           22127           22230          22076            22181
##        ...                                                                
## 2020-08-19           19833           20055          19734            20055
## 2020-08-20           19827           19921          19719            19767
## 2020-08-21           19846           19868          19480            19695
## 2020-08-24           19908           20130          19887            20113
## 2020-08-25           20256           20368          20030            20030
## 2020-08-26           19971           20137          19928            20137
## 2020-08-27           20131           20133          19847            19847
## 2020-08-28           19953           19992          19687            19841
## 2020-08-31           19972           20081          19616            19634
## 2020-09-01           19776           19871          19435            19595
##            FTSEMIB.MI.Volume FTSEMIB.MI.Adjusted
## 2019-09-02         227807500               21452
## 2019-09-03         283939100               21399
## 2019-09-04         408310000               21738
## 2019-09-05         444458900               21955
## 2019-09-06         396569400               21947
## 2019-09-09         358176500               21990
## 2019-09-10         465833900               21869
## 2019-09-11         520578100               21892
## 2019-09-12         576922200               22083
## 2019-09-13         489149200               22181
##        ...                                      
## 2020-08-19         221316800               20055
## 2020-08-20         264922400               19767
## 2020-08-21         300533200               19695
## 2020-08-24         304828800               20113
## 2020-08-25         327848800               20030
## 2020-08-26         336048100               20137
## 2020-08-27         479171100               19847
## 2020-08-28         475736200               19841
## 2020-08-31         411640300               19634
## 2020-09-01         429280800               19595
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253
## 
## Slot "name":
## [1] "FTSEMIB.MI"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## FTSEMIB.MI
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 253
## 
## Slot "yrange":
## [1] 14153 25483
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 253
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 02\n2019 Oct 01\n2019 Nov 01\n2019 Dec 02\n2019 Jan 02\n2020 Feb 03\n2020 
##            1           21           44           65           83          105 
## Mar 02\n2020 Apr 01\n2020 May 04\n2020 Jun 01\n2020 Jul 01\n2020 Aug 03\n2020 
##          125          147          167          187          209          232 
## Sep 01\n2020 Sep 01\n2020 
##          253          253 
## 
## Slot "x.labels":
##  [1] "Sep 02\n2019" "Oct 01\n2019" "Nov 01\n2019" "Dec 02\n2019" "Jan 02\n2020"
##  [6] "Feb 03\n2020" "Mar 02\n2020" "Apr 01\n2020" "May 04\n2020" "Jun 01\n2020"
## [11] "Jul 01\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 01\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
print(chartSeries(FCHI, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = FCHI, TA = NULL)
## 
## Slot "xdata":
##            FCHI.Open FCHI.High FCHI.Low FCHI.Close FCHI.Volume FCHI.Adjusted
## 2019-09-02   5483.43   5502.58  5479.82    5493.04    42347400       5493.04
## 2019-09-03   5484.36   5484.54  5441.18    5466.07    57453400       5466.07
## 2019-09-04   5518.92   5537.10  5508.50    5532.07    60939800       5532.07
## 2019-09-05   5569.59   5605.88  5559.82    5593.37    84379600       5593.37
## 2019-09-06   5592.07   5610.70  5581.54    5603.99    71138100       5603.99
## 2019-09-09   5606.36   5611.59  5579.93    5588.95    73880200       5588.95
## 2019-09-10   5586.88   5596.94  5555.51    5593.21   106338200       5593.21
## 2019-09-11   5606.43   5626.05  5606.43    5618.06    92098300       5618.06
## 2019-09-12   5633.95   5667.46  5596.37    5642.86   110360200       5642.86
## 2019-09-13   5649.23   5672.07  5638.17    5655.46    85595400       5655.46
##        ...                                                                  
## 2020-08-19   4934.79   4977.23  4917.53    4977.23    53103600       4977.23
## 2020-08-20   4914.69   4937.95  4888.15    4911.24    66410900       4911.24
## 2020-08-21   4927.61   4939.25  4839.08    4896.33    72886800       4896.33
## 2020-08-24   4948.71   5013.70  4948.71    5007.89    68837200       5007.89
## 2020-08-25   5023.06   5073.61  5008.27    5008.27    64060000       5008.27
## 2020-08-26   4991.63   5050.10  4977.94    5048.43    49317700       5048.43
## 2020-08-27   5052.26   5052.26  5005.46    5015.97    67454700       5015.97
## 2020-08-28   5031.31   5031.53  4970.64    5002.94    71208000       5002.94
## 2020-08-31   5041.34   5067.55  4942.18    4947.22    97432500       4947.22
## 2020-09-01   4974.42   4993.56  4892.83    4938.10    91322100       4938.10
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253 254 255 256
## 
## Slot "name":
## [1] "FCHI"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## FCHI
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 256
## 
## Slot "yrange":
## [1] 3632.06 6111.41
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 256
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 02\n2019 Oct 01\n2019 Nov 01\n2019 Dec 02\n2019 Jan 02\n2020 Feb 03\n2020 
##            1           22           45           66           86          108 
## Mar 02\n2020 Apr 01\n2020 May 04\n2020 Jun 01\n2020 Jul 01\n2020 Aug 03\n2020 
##          128          150          170          190          212          235 
## Sep 01\n2020 Sep 01\n2020 
##          256          256 
## 
## Slot "x.labels":
##  [1] "Sep 02\n2019" "Oct 01\n2019" "Nov 01\n2019" "Dec 02\n2019" "Jan 02\n2020"
##  [6] "Feb 03\n2020" "Mar 02\n2020" "Apr 01\n2020" "May 04\n2020" "Jun 01\n2020"
## [11] "Jul 01\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 01\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
print(chartSeries(AXJO, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = AXJO, TA = NULL)
## 
## Slot "xdata":
##            AXJO.Open AXJO.High AXJO.Low AXJO.Close AXJO.Volume AXJO.Adjusted
## 2019-09-02    6604.2    6604.8   6558.3     6579.4      525000        6579.4
## 2019-09-03    6579.4    6591.3   6554.3     6573.4      479400        6573.4
## 2019-09-04    6573.4    6573.4   6503.9     6553.0      695600        6553.0
## 2019-09-05    6553.0    6622.8   6551.0     6613.2      796300        6613.2
## 2019-09-06    6613.2    6656.1   6613.2     6647.3      702600        6647.3
## 2019-09-09    6647.3    6659.7   6631.2     6648.0      542900        6648.0
## 2019-09-10    6648.0    6654.8   6595.7     6614.1      746300        6614.1
## 2019-09-11    6614.1    6638.4   6614.1     6638.0      811400        6638.0
## 2019-09-12    6638.0    6687.4   6638.0     6654.9      662600        6654.9
## 2019-09-13    6654.9    6676.5   6653.7     6669.2      673900        6669.2
##        ...                                                                  
## 2020-08-20    6167.6    6167.6   6096.7     6120.0      867100        6120.0
## 2020-08-21    6120.0    6166.4   6104.8     6111.2      812200        6111.2
## 2020-08-24    6111.2    6134.8   6094.7     6129.6      793800        6129.6
## 2020-08-25    6129.6    6199.2   6129.6     6161.4      901000        6161.4
## 2020-08-26    6160.4    6160.4   6079.8     6116.4      886400        6116.4
## 2020-08-27    6119.1    6159.8   6117.1     6126.2      824900        6126.2
## 2020-08-28    6126.2    6126.2   6056.0     6073.8      785300        6073.8
## 2020-08-31    6073.8    6093.9   6060.5     6060.5      811400        6060.5
## 2020-09-01    6060.5    6060.5   5908.9     5953.4      885100        5953.4
## 2020-09-02    5953.4    6075.7   5953.4     6063.2      786400        6063.2
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253 254 255
## 
## Slot "name":
## [1] "AXJO"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## AXJO
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 255
## 
## Slot "yrange":
## [1] 4402.5 7197.2
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 255
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 02\n2019 Oct 01\n2019 Nov 03\n2019 Dec 01\n2019 Jan 01\n2020 Feb 02\n2020 
##            1           22           45           65           85          106 
## Mar 01\n2020 Apr 01\n2020 May 01\n2020 Jun 01\n2020 Jul 01\n2020 Aug 03\n2020 
##          126          149          168          189          210          233 
## Sep 01\n2020 Sep 02\n2020 
##          254          255 
## 
## Slot "x.labels":
##  [1] "Sep 02\n2019" "Oct 01\n2019" "Nov 03\n2019" "Dec 01\n2019" "Jan 01\n2020"
##  [6] "Feb 02\n2020" "Mar 01\n2020" "Apr 01\n2020" "May 01\n2020" "Jun 01\n2020"
## [11] "Jul 01\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 02\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
print(chartSeries(HSI, TA = NULL))

## An object of class "chob"
## Slot "device":
## [1] 2
## 
## Slot "call":
## chartSeries(x = HSI, TA = NULL)
## 
## Slot "xdata":
##            HSI.Open HSI.High  HSI.Low HSI.Close HSI.Volume HSI.Adjusted
## 2019-09-02 25627.83 25662.31 25502.70  25626.55 1295066700     25626.55
## 2019-09-03 25546.32 25736.05 25498.11  25527.85 1149210200     25527.85
## 2019-09-04 25675.16 26654.21 25675.16  26523.23 2688524600     26523.23
## 2019-09-05 26512.86 26697.85 26283.12  26515.53 1996619100     26515.53
## 2019-09-06 26773.13 26790.79 26563.17  26690.76 1895344700     26690.76
## 2019-09-09 26743.36 26807.86 26609.65  26681.40 1700948300     26681.40
## 2019-09-10 26831.98 26870.77 26634.47  26683.68 1738020300     26683.68
## 2019-09-11 26790.64 27159.51 26705.63  27159.06 2072246200     27159.06
## 2019-09-12 27283.98 27283.98 26967.25  27087.63 1337046900     27087.63
## 2019-09-13 27154.51 27366.45 27074.54  27352.69 1176496300     27352.69
##        ...                                                             
## 2020-08-19 25359.03 25382.51 25079.25  25178.91 1132238600     25178.91
## 2020-08-20 25055.35 25055.35 24621.32  24791.39 1995701500     24791.39
## 2020-08-21 25007.13 25178.79 24885.86  25113.84 1210267900     25113.84
## 2020-08-24 25352.79 25551.58 25325.15  25551.58 1352263800     25551.58
## 2020-08-25 25586.99 25621.08 25352.26  25486.22 1350837400     25486.22
## 2020-08-26 25520.41 25603.17 25360.03  25491.79 1319876200     25491.79
## 2020-08-27 25469.77 25469.77 25186.42  25281.15 1701268300     25281.15
## 2020-08-28 25330.77 25749.40 25258.16  25422.06 2065272600     25422.06
## 2020-08-31 25732.49 25847.11 25177.05  25177.05 3195378200     25177.05
## 2020-09-01 25085.67 25254.14 24995.45  25184.85 1729452000     25184.85
## 
## Slot "xsubset":
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
## 
## Slot "name":
## [1] "HSI"
## 
## Slot "type":
## [1] "candlesticks"
## 
## Slot "passed.args":
## $x
## HSI
## 
## $TA
## list()
## 
## 
## Slot "windows":
## [1] 1
## 
## Slot "xrange":
## [1]   1 249
## 
## Slot "yrange":
## [1] 21139.26 29174.92
## 
## Slot "log.scale":
## [1] FALSE
## 
## Slot "length":
## [1] 249
## 
## Slot "color.vol":
## [1] TRUE
## 
## Slot "multi.col":
## [1] FALSE
## 
## Slot "show.vol":
## [1] TRUE
## 
## Slot "show.grid":
## [1] TRUE
## 
## Slot "line.type":
## [1] "l"
## 
## Slot "bar.type":
## [1] "ohlc"
## 
## Slot "xlab":
## character(0)
## 
## Slot "ylab":
## character(0)
## 
## Slot "spacing":
## [1] 3
## 
## Slot "width":
## [1] 3
## 
## Slot "bp":
## Sep 02\n2019 Oct 02\n2019 Nov 01\n2019 Dec 02\n2019 Jan 02\n2020 Feb 03\n2020 
##            1           22           43           64           84          104 
## Mar 02\n2020 Apr 01\n2020 May 04\n2020 Jun 01\n2020 Jul 02\n2020 Aug 03\n2020 
##          124          146          165          185          206          228 
## Sep 01\n2020 Sep 01\n2020 
##          249          249 
## 
## Slot "x.labels":
##  [1] "Sep 02\n2019" "Oct 02\n2019" "Nov 01\n2019" "Dec 02\n2019" "Jan 02\n2020"
##  [6] "Feb 03\n2020" "Mar 02\n2020" "Apr 01\n2020" "May 04\n2020" "Jun 01\n2020"
## [11] "Jul 02\n2020" "Aug 03\n2020" "Sep 01\n2020" "Sep 01\n2020"
## 
## Slot "colors":
## List of 27
##  $ fg.col      : chr "#666666"
##  $ bg.col      : chr "#222222"
##  $ grid.col    : chr "#303030"
##  $ border      : chr "#666666"
##  $ minor.tick  : chr "#303030"
##  $ major.tick  : chr "#AAAAAA"
##  $ up.col      : chr "#00FF00"
##  $ dn.col      : chr "#FF9900"
##  $ dn.up.col   : chr "#00FF00"
##  $ up.up.col   : chr "#00FF00"
##  $ dn.dn.col   : chr "#FF9900"
##  $ up.dn.col   : chr "#FF9900"
##  $ up.border   : chr "#666666"
##  $ dn.border   : chr "#666666"
##  $ dn.up.border: chr "#666666"
##  $ up.up.border: chr "#666666"
##  $ dn.dn.border: chr "#666666"
##  $ up.dn.border: chr "#666666"
##  $ main.col    : chr "#999999"
##  $ sub.col     : chr "#999999"
##  $ area        : chr "#252525"
##  $ fill        : chr "#282828"
##  $ Expiry      : chr "#383838"
##  $ BBands.col  : chr "red"
##  $ BBands.fill : chr "#282828"
##  $ BBands      :List of 2
##   ..$ col : chr "red"
##   ..$ fill: chr "#282828"
##  $ theme.name  : chr "black"
##  - attr(*, "class")= chr "chart.theme"
## 
## Slot "layout":
## [1] NA
## 
## Slot "time.scale":
## [1] "daily"
## 
## Slot "minor.ticks":
## [1] TRUE
## 
## Slot "major.ticks":
## [1] "auto"
png(file.path(plotpath, "FTSE_stock.png"), width = 800, height = 600)
chartSeries(FTSE, TA = NULL)
addTA(Cl(FTSE), on = 1, col = "blue", lwd = 2)
addTA(Op(FTSE), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
png(file.path(plotpath, "GSPC_stock.png"), width = 800, height = 600)
chartSeries(GSPC, TA = NULL)
addTA(Cl(GSPC), on = 1, col = "blue", lwd = 2)
addTA(Op(GSPC), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
png(file.path(plotpath, "GDAXI_stock.png"), width = 800, height = 600)
chartSeries(GDAXI, TA = NULL)
addTA(Cl(GDAXI), on = 1, col = "blue", lwd = 2)
addTA(Op(GDAXI), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
png(file.path(plotpath, "FTSEMIB_stock.png"), width = 800, height = 600)
chartSeries(FTSEMIB.MI, TA = NULL)
addTA(Cl(FTSEMIB.MI), on = 1, col = "blue", lwd = 2)
addTA(Op(FTSEMIB.MI), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
png(file.path(plotpath, "FCHI_stock.png"), width = 800, height = 600)
chartSeries(FCHI, TA = NULL)
addTA(Cl(FCHI), on = 1, col = "blue", lwd = 2)
addTA(Op(FCHI), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
png(file.path(plotpath, "AXJO_stock.png"), width = 800, height = 600)
chartSeries(AXJO, TA = NULL)
addTA(Cl(AXJO), on = 1, col = "blue", lwd = 2)
addTA(Op(AXJO), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
png(file.path(plotpath, "HSI_stock.png"), width = 800, height = 600)
chartSeries(HSI, TA = NULL)
addTA(Cl(HSI), on = 1, col = "blue", lwd = 2)
addTA(Op(HSI), on = 1, col = "red", lwd = 2)
dev.off()
## quartz_off_screen 
##                 2
FTSE_models_list <- make_similarity_matrices(dates2use[["FTSE_dates"]],
                                            indices2use[["FTSE_index"]],
                                            vals2use[["FTSE_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'FTSE'),
                                            save_out = TRUE)

GSPC_models_list <- make_similarity_matrices(dates2use[["GSPC_dates"]],
                                            indices2use[["GSPC_index"]],
                                            vals2use[["GSPC_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'GSPC'),
                                            save_out = TRUE)

GDAXI_models_list <- make_similarity_matrices(dates2use[["GDAXI_dates"]],
                                            indices2use[["GDAXI_index"]],
                                            vals2use[["GDAXI_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'GDAXI'),
                                            save_out = TRUE)

FTSEMIB.MI_models_list <- make_similarity_matrices(dates2use[["FTSEMIB.MI_dates"]],
                                            indices2use[["FTSEMIB.MI_index"]],
                                            vals2use[["FTSEMIB.MI_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'FTSEMIB'),
                                            save_out = TRUE)

FCHI_models_list <- make_similarity_matrices(dates2use[["FCHI_dates"]],
                                            indices2use[["FCHI_index"]],
                                            vals2use[["FCHI_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'FCHI'),
                                            save_out = TRUE)

AXJO_models_list <- make_similarity_matrices(dates2use[["AXJO_dates"]],
                                            indices2use[["AXJO_index"]],
                                            vals2use[["AXJO_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'AXJO'),
                                            save_out = TRUE)

HSI_models_list <- make_similarity_matrices(dates2use[["HSI_dates"]],
                                            indices2use[["HSI_index"]],
                                            vals2use[["HSI_center"]],
                                            center_value_name_list,
                                            file.path(resultpath, 'HSI'),
                                            save_out = TRUE)
# OPENING PRICES

FTSE_open_similarity <- compute_single_variable_similarity(
  FTSE_df$FTSE.Open,
  indices2use[["FTSE_index"]],
  "FTSE_open_similarity",
  file.path(resultpath, 'FTSE'), 
  TRUE
)

GSPC_open_similarity <- compute_single_variable_similarity(
  GSPC_df$GSPC.Open,
  indices2use[["GSPC_index"]],
  "GSPC_open_similarity",
  file.path(resultpath, 'GSPC'), 
  TRUE
)

GDAXI_open_similarity <- compute_single_variable_similarity(
  GDAXI_df$GDAXI.Open,
  indices2use[["GDAXI_index"]],
  "GDAXI_open_similarity",
  file.path(resultpath, 'GDAXI'), 
  TRUE
)

FTSEMIB.MI_open_similarity <- compute_single_variable_similarity(
  FTSEMIB.MI_df$FTSEMIB.MI.Open,
  indices2use[["FTSEMIB.MI_index"]],
  "FTSEMIB.MI_open_similarity",
  file.path(resultpath, 'FTSEMIB'), 
  TRUE
)

FCHI_open_similarity <- compute_single_variable_similarity(
  FCHI_df$FCHI.Open,
  indices2use[["FCHI_index"]],
  "FCHI_open_similarity",
  file.path(resultpath, 'FCHI'), 
  TRUE
)

AXJO_open_similarity <- compute_single_variable_similarity(
  AXJO_df$AXJO.Open,
  indices2use[["AXJO_index"]],
  "AXJO_open_similarity",
  file.path(resultpath, 'AXJO'), 
  TRUE
)

HSI_open_similarity <- compute_single_variable_similarity(
  HSI_df$HSI.Open,
  indices2use[["HSI_index"]],
  "HSI_open_similarity",
  file.path(resultpath, 'HSI'), 
  TRUE
)

# CLOSING PRICES

FTSE_close_similarity <- compute_single_variable_similarity(
  FTSE_df$FTSE.Close,
  indices2use[["FTSE_index"]],
  "FTSE_close_similarity",
  file.path(resultpath, 'FTSE'), 
  TRUE
)

GSPC_close_similarity <- compute_single_variable_similarity(
  GSPC_df$GSPC.Close,
  indices2use[["GSPC_index"]],
  "GSPC_close_similarity",
  file.path(resultpath, 'GSPC'), 
  TRUE
)

GDAXI_close_similarity <- compute_single_variable_similarity(
  GDAXI_df$GDAXI.Close,
  indices2use[["GDAXI_index"]],
  "GDAXI_close_similarity",
  file.path(resultpath, 'GDAXI'), 
  TRUE
)

FTSEMIB.MI_close_similarity <- compute_single_variable_similarity(
  FTSEMIB.MI_df$FTSEMIB.MI.Close,
  indices2use[["FTSEMIB.MI_index"]],
  "FTSEMIB.MI_close_similarity",
  file.path(resultpath, 'FTSEMIB'), 
  TRUE
)

FCHI_close_similarity <- compute_single_variable_similarity(
  FCHI_df$FCHI.Close,
  indices2use[["FCHI_index"]],
  "FCHI_close_similarity",
  file.path(resultpath, 'FCHI'), 
  TRUE
)

AXJO_close_similarity <- compute_single_variable_similarity(
  AXJO_df$AXJO.Close,
  indices2use[["AXJO_index"]],
  "AXJO_close_similarity",
  file.path(resultpath, 'AXJO'), 
  TRUE
)

HSI_close_similarity <- compute_single_variable_similarity(
  HSI_df$HSI.Close,
  indices2use[["HSI_index"]],
  "HSI_close_similarity",
  file.path(resultpath, 'HSI'), 
  TRUE
)

FTSE_list <- list(FTSE_open_similarity,
                   FTSE_close_similarity)
names(FTSE_list) <- c("open", "close")

GSPC_list <- list(GSPC_open_similarity,
                   GSPC_close_similarity)
names(GSPC_list) <- c("open", "close")

GDAXI_list <- list(GDAXI_open_similarity,
                   GDAXI_close_similarity)
names(GDAXI_list) <- c("open", "close")

FTSEMIB.MI_list <- list(FTSEMIB.MI_open_similarity,
                   FTSEMIB.MI_close_similarity)
names(FTSEMIB.MI_list) <- c("open", "close")

FCHI_list <- list(FCHI_open_similarity,
                   FCHI_close_similarity)
names(FCHI_list) <- c("open", "close")

AXJO_list <- list(AXJO_open_similarity,
                   AXJO_close_similarity)
names(AXJO_list) <- c("open", "close")

HSI_list <- list(HSI_open_similarity,
                   HSI_close_similarity)
names(HSI_list) <- c("open", "close")

Compared modelled to real data

mantel_res_FTSE <- mantel_results_models(FTSE_models_list,
                                          FTSE_list,
                                          nperm,
                                          n_behave_models)
mantel_res_FTSE$model <- rownames(mantel_res_FTSE)

# order by increasing R
mantel_res_FTSE <- mantel_res_FTSE[order(mantel_res_FTSE$r),]

mantel_res_FTSE %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_divclose 0.003996 0.0609820 0.0039960 behave_divclose
behave_divopen 0.003996 0.0714001 0.0039960 behave_divopen
behave_convopen 0.000999 0.1332657 0.0011239 behave_convopen
behave_convclose 0.000999 0.1424187 0.0011239 behave_convclose
punctuacted_chinaopen 0.000999 0.4627748 0.0011239 punctuacted_chinaopen
punctuacted_chinaclose 0.000999 0.4742115 0.0011239 punctuacted_chinaclose
behave_nnopen 0.000999 0.6000199 0.0011239 behave_nnopen
behave_nnclose 0.000999 0.6009709 0.0011239 behave_nnclose
punctuated_nn_chinaopen 0.000999 0.6208935 0.0011239 punctuated_nn_chinaopen
punctuated_nn_chinaclose 0.000999 0.6248661 0.0011239 punctuated_nn_chinaclose
punctuated_nn_usaclose 0.000999 0.6849208 0.0011239 punctuated_nn_usaclose
punctuated_nn_usaopen 0.000999 0.6853251 0.0011239 punctuated_nn_usaopen
punctuated_nn_whoopen 0.000999 0.6866273 0.0011239 punctuated_nn_whoopen
punctuated_nn_whoclose 0.000999 0.6866771 0.0011239 punctuated_nn_whoclose
punctuacted_usaclose 0.000999 0.7338806 0.0011239 punctuacted_usaclose
punctuacted_usaopen 0.000999 0.7390414 0.0011239 punctuacted_usaopen
punctuacted_whoclose 0.000999 0.7480523 0.0011239 punctuacted_whoclose
punctuacted_whoopen 0.000999 0.7512667 0.0011239 punctuacted_whoopen

Compare resulting R values

n1 <- nrow(FTSE_df)
n2 <- nrow(FTSE_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_FTSE)){
  for (j in 1:nrow(mantel_res_FTSE)){
  
  model_i <- mantel_res_FTSE[i, "model"]
  model_j <- mantel_res_FTSE[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_FTSE[i, "r"]
  r_j <- mantel_res_FTSE[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_FTSE),
                        nrow(mantel_res_FTSE))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_FTSE$model
colnames(corr_p_matrix) <- mantel_res_FTSE$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_FTSE$model
colnames(binary_sig) <- mantel_res_FTSE$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_FTSE.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
FTSE_row <- binary_sig[nrow(binary_sig),]
FTSE_row <- data.frame(FTSE_row)
FTSE_high_names <- rownames(FTSE_row)[FTSE_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(FTSE_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuated_nn_usaclose, punctuated_nn_usaopen, punctuated_nn_whoopen, punctuated_nn_whoclose, punctuacted_usaclose, punctuacted_usaopen, punctuacted_whoclose, punctuacted_whoopen"
FTSE_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

FTSE_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_divopen_behave_divclose Yes 0.4533 0.4849993 No
behave_convopen_behave_divclose Yes 0.2067 0.2432700 No
behave_convclose_behave_divclose Yes 0.1782 0.2113535 No
punctuacted_chinaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_convopen_behave_divopen Yes 0.2418 0.2802682 No
behave_convclose_behave_divopen Yes 0.2104 0.2457344 No
punctuacted_chinaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_convclose_behave_convopen Yes 0.4584 0.4870500 No
punctuacted_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_punctuacted_chinaopen Yes 0.4348 0.4718043 No
behave_nnopen_punctuacted_chinaopen Yes 0.0156 0.0253915 Yes
behave_nnclose_punctuacted_chinaopen Yes 0.0150 0.0246774 Yes
punctuated_nn_chinaopen_punctuacted_chinaopen Yes 0.0057 0.0101407 Yes
punctuated_nn_chinaclose_punctuacted_chinaopen Yes 0.0047 0.0084600 Yes
punctuated_nn_usaclose_punctuacted_chinaopen Yes 1e-04 0.0002125 Yes
punctuated_nn_usaopen_punctuacted_chinaopen Yes 1e-04 0.0002125 Yes
punctuated_nn_whoopen_punctuacted_chinaopen Yes 1e-04 0.0002125 Yes
punctuated_nn_whoclose_punctuacted_chinaopen Yes 1e-04 0.0002125 Yes
punctuacted_usaclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
behave_nnopen_punctuacted_chinaclose Yes 0.0233 0.0371344 Yes
behave_nnclose_punctuacted_chinaclose Yes 0.0224 0.0360758 Yes
punctuated_nn_chinaopen_punctuacted_chinaclose Yes 0.0091 0.0153000 Yes
punctuated_nn_chinaclose_punctuacted_chinaclose Yes 0.0074 0.0128659 Yes
punctuated_nn_usaclose_punctuacted_chinaclose Yes 1e-04 0.0002125 Yes
punctuated_nn_usaopen_punctuacted_chinaclose Yes 1e-04 0.0002125 Yes
punctuated_nn_whoopen_punctuacted_chinaclose Yes 1e-04 0.0002125 Yes
punctuated_nn_whoclose_punctuacted_chinaclose Yes 1e-04 0.0002125 Yes
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_nnopen Yes 0.4934 0.4996000 No
punctuated_nn_chinaopen_behave_nnopen Yes 0.3546 0.3989250 No
punctuated_nn_chinaclose_behave_nnopen Yes 0.3280 0.3773233 No
punctuated_nn_usaclose_behave_nnopen Yes 0.0520 0.0780000 No
punctuated_nn_usaopen_behave_nnopen Yes 0.0511 0.0774089 No
punctuated_nn_whoopen_behave_nnopen Yes 0.0482 0.0752510 No
punctuated_nn_whoclose_behave_nnopen Yes 0.0481 0.0752510 No
punctuacted_usaclose_behave_nnopen Yes 0.0031 0.0059288 Yes
punctuacted_usaopen_behave_nnopen Yes 0.0021 0.0041727 Yes
punctuacted_whoclose_behave_nnopen Yes 0.0010 0.0020400 Yes
punctuacted_whoopen_behave_nnopen Yes 8e-04 0.0016541 Yes
punctuated_nn_chinaopen_behave_nnclose Yes 0.3609 0.4017913 No
punctuated_nn_chinaclose_behave_nnclose Yes 0.3340 0.3785333 No
punctuated_nn_usaclose_behave_nnclose Yes 0.0538 0.0791481 No
punctuated_nn_usaopen_behave_nnclose Yes 0.0528 0.0784311 No
punctuated_nn_whoopen_behave_nnclose Yes 0.0499 0.0763470 No
punctuated_nn_whoclose_behave_nnclose Yes 0.0498 0.0763470 No
punctuacted_usaclose_behave_nnclose Yes 0.0033 0.0060831 Yes
punctuacted_usaopen_behave_nnclose Yes 0.0022 0.0043154 Yes
punctuacted_whoclose_behave_nnclose Yes 0.0011 0.0022145 Yes
punctuacted_whoopen_behave_nnclose Yes 8e-04 0.0016541 Yes
punctuated_nn_chinaclose_punctuated_nn_chinaopen Yes 0.4710 0.4935822 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.1051 0.1386233 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.1035 0.1377000 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.0986 0.1323316 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.0985 0.1323316 No
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.0091 0.0153000 Yes
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.0065 0.0114310 Yes
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.0033 0.0060831 Yes
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.0026 0.0050354 Yes
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.1189 0.1467073 No
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.1172 0.1457854 No
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.1119 0.1426725 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.1117 0.1426725 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.0111 0.0184598 Yes
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.0079 0.0135809 Yes
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.0042 0.0076500 Yes
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.0033 0.0060831 Yes
punctuated_nn_usaopen_punctuated_nn_usaclose Yes 0.4966 0.4996000 No
punctuated_nn_whoopen_punctuated_nn_usaclose Yes 0.4856 0.4987800 No
punctuated_nn_whoclose_punctuated_nn_usaclose Yes 0.4852 0.4987800 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.1343 0.1643832 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.1088 0.1422769 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.0723 0.1014853 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.0617 0.0899057 No
punctuated_nn_whoopen_punctuated_nn_usaopen Yes 0.4890 0.4987800 No
punctuated_nn_whoclose_punctuated_nn_usaopen Yes 0.4886 0.4987800 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.1361 0.1652643 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.1104 0.1426725 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.0735 0.1022318 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.0627 0.0905009 No
punctuated_nn_whoclose_punctuated_nn_whoopen Yes 0.4996 0.4996000 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.1422 0.1703320 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.1157 0.1453500 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.0775 0.1060071 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.0662 0.0939250 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.1425 0.1703320 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.1159 0.1453500 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.0776 0.1060071 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.0663 0.0939250 No
punctuacted_usaopen_punctuacted_usaclose Yes 0.4497 0.4845359 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.3624 0.4017913 No
punctuacted_whoopen_punctuacted_usaclose Yes 0.3320 0.3785333 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.4107 0.4488364 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.3790 0.4171727 No
punctuacted_whoopen_punctuacted_whoclose Yes 0.4672 0.4929766 No

Compare modelled to real data

mantel_res_GSPC <- mantel_results_models(GSPC_models_list,
                                          GSPC_list,
                                          nperm,
                                          n_behave_models)

mantel_res_GSPC$model <- rownames(mantel_res_GSPC)
#order by increasing R
mantel_res_GSPC <- mantel_res_GSPC[order(mantel_res_GSPC$r),]

mantel_res_GSPC %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_convclose 1.0000000 -0.1359293 1.0000000 behave_convclose
behave_convopen 1.0000000 -0.1315663 1.0000000 behave_convopen
punctuacted_chinaclose 0.3536464 0.0083424 0.3978521 punctuacted_chinaclose
punctuacted_chinaopen 0.2577423 0.0138074 0.3092907 punctuacted_chinaopen
punctuated_nn_chinaclose 0.0019980 0.0704115 0.0025689 punctuated_nn_chinaclose
punctuated_nn_chinaopen 0.0009990 0.0710445 0.0013832 punctuated_nn_chinaopen
behave_nnopen 0.0009990 0.1185961 0.0013832 behave_nnopen
behave_nnclose 0.0009990 0.1193444 0.0013832 behave_nnclose
punctuated_nn_whoopen 0.0009990 0.1369379 0.0013832 punctuated_nn_whoopen
punctuated_nn_whoclose 0.0009990 0.1372854 0.0013832 punctuated_nn_whoclose
punctuated_nn_usaopen 0.0009990 0.1384349 0.0013832 punctuated_nn_usaopen
punctuated_nn_usaclose 0.0009990 0.1388339 0.0013832 punctuated_nn_usaclose
behave_divopen 0.0009990 0.1614090 0.0013832 behave_divopen
behave_divclose 0.0009990 0.1676144 0.0013832 behave_divclose
punctuacted_usaopen 0.0009990 0.1734897 0.0013832 punctuacted_usaopen
punctuacted_usaclose 0.0009990 0.1746060 0.0013832 punctuacted_usaclose
punctuacted_whoopen 0.0009990 0.1778952 0.0013832 punctuacted_whoopen
punctuacted_whoclose 0.0009990 0.1788128 0.0013832 punctuacted_whoclose

Compare resulting correlations

n1 <- nrow(GSPC_df)
n2 <- nrow(GSPC_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_GSPC)){
  for (j in 1:nrow(mantel_res_GSPC)){
  
  model_i <- mantel_res_GSPC[i, "model"]
  model_j <- mantel_res_GSPC[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_GSPC[i, "r"]
  r_j <- mantel_res_GSPC[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_GSPC),
                        nrow(mantel_res_GSPC))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_GSPC$model
colnames(corr_p_matrix) <- mantel_res_GSPC$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_GSPC$model
colnames(binary_sig) <- mantel_res_GSPC$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_GSPC.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
GSPC_row <- binary_sig[nrow(binary_sig),]
GSPC_row <- data.frame(GSPC_row)
GSPC_high_names <- rownames(GSPC_row)[GSPC_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(GSPC_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuacted_chinaclose, punctuacted_chinaopen, punctuated_nn_chinaclose, punctuated_nn_chinaopen, behave_nnopen, behave_nnclose, punctuated_nn_whoopen, punctuated_nn_whoclose, punctuated_nn_usaopen, punctuated_nn_usaclose, behave_divopen, behave_divclose, punctuacted_usaopen, punctuacted_usaclose, punctuacted_whoopen, punctuacted_whoclose"
GSPC_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

GSPC_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_convopen_behave_convclose Yes 0.4802 0.4984000 No
punctuacted_chinaclose_behave_convclose Yes 0.0524 0.1864465 No
punctuacted_chinaopen_behave_convclose Yes 0.0461 0.1763325 No
punctuated_nn_chinaclose_behave_convclose Yes 0.0102 0.0600231 No
punctuated_nn_chinaopen_behave_convclose Yes 0.0100 0.0600231 No
behave_nnopen_behave_convclose Yes 0.0021 0.0146045 Yes
behave_nnclose_behave_convclose Yes 0.0021 0.0146045 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0011 0.0096632 Yes
punctuated_nn_whoclose_behave_convclose Yes 0.0011 0.0096632 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0010 0.0096632 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0010 0.0096632 Yes
behave_divopen_behave_convclose Yes 4e-04 0.0055636 Yes
behave_divclose_behave_convclose Yes 3e-04 0.0051000 Yes
punctuacted_usaopen_behave_convclose Yes 2e-04 0.0051000 Yes
punctuacted_usaclose_behave_convclose Yes 2e-04 0.0051000 Yes
punctuacted_whoopen_behave_convclose Yes 2e-04 0.0051000 Yes
punctuacted_whoclose_behave_convclose Yes 2e-04 0.0051000 Yes
punctuacted_chinaclose_behave_convopen Yes 0.0579 0.2013341 No
punctuacted_chinaopen_behave_convopen Yes 0.0511 0.1861500 No
punctuated_nn_chinaclose_behave_convopen Yes 0.0117 0.0639321 No
punctuated_nn_chinaopen_behave_convopen Yes 0.0114 0.0639321 No
behave_nnopen_behave_convopen Yes 0.0025 0.0159375 Yes
behave_nnclose_behave_convopen Yes 0.0024 0.0159375 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0013 0.0099450 Yes
punctuated_nn_whoclose_behave_convopen Yes 0.0012 0.0096632 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0012 0.0096632 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0012 0.0096632 Yes
behave_divopen_behave_convopen Yes 5e-04 0.0063750 Yes
behave_divclose_behave_convopen Yes 4e-04 0.0055636 Yes
punctuacted_usaopen_behave_convopen Yes 3e-04 0.0051000 Yes
punctuacted_usaclose_behave_convopen Yes 3e-04 0.0051000 Yes
punctuacted_whoopen_behave_convopen Yes 2e-04 0.0051000 Yes
punctuacted_whoclose_behave_convopen Yes 2e-04 0.0051000 Yes
punctuacted_chinaopen_punctuacted_chinaclose Yes 0.4756 0.4984000 No
punctuated_nn_chinaclose_punctuacted_chinaclose Yes 0.2434 0.4659545 No
punctuated_nn_chinaopen_punctuacted_chinaclose Yes 0.2412 0.4659545 No
behave_nnopen_punctuacted_chinaclose Yes 0.1077 0.2921344 No
behave_nnclose_punctuacted_chinaclose Yes 0.1061 0.2921344 No
punctuated_nn_whoopen_punctuacted_chinaclose Yes 0.0739 0.2355562 No
punctuated_nn_whoclose_punctuacted_chinaclose Yes 0.0733 0.2355562 No
punctuated_nn_usaopen_punctuacted_chinaclose Yes 0.0715 0.2355562 No
punctuated_nn_usaclose_punctuacted_chinaclose Yes 0.0709 0.2355562 No
behave_divopen_punctuacted_chinaclose Yes 0.0421 0.1651615 No
behave_divclose_punctuacted_chinaclose Yes 0.0360 0.1488649 No
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0310 0.1426500 No
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0301 0.1426500 No
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0276 0.1407600 No
punctuacted_whoclose_punctuacted_chinaclose Yes 0.0269 0.1407600 No
punctuated_nn_chinaclose_punctuacted_chinaopen Yes 0.2630 0.4659545 No
punctuated_nn_chinaopen_punctuacted_chinaopen Yes 0.2607 0.4659545 No
behave_nnopen_punctuacted_chinaopen Yes 0.1194 0.2921344 No
behave_nnclose_punctuacted_chinaopen Yes 0.1177 0.2921344 No
punctuated_nn_whoopen_punctuacted_chinaopen Yes 0.0828 0.2436231 No
punctuated_nn_whoclose_punctuacted_chinaopen Yes 0.0822 0.2436231 No
punctuated_nn_usaopen_punctuacted_chinaopen Yes 0.0803 0.2436231 No
punctuated_nn_usaclose_punctuacted_chinaopen Yes 0.0796 0.2436231 No
behave_divopen_punctuacted_chinaopen Yes 0.0478 0.1783756 No
behave_divclose_punctuacted_chinaopen Yes 0.0412 0.1651615 No
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0355 0.1488649 No
punctuacted_usaclose_punctuacted_chinaopen Yes 0.0345 0.1488649 No
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0317 0.1426500 No
punctuacted_whoclose_punctuacted_chinaopen Yes 0.0310 0.1426500 No
punctuated_nn_chinaopen_punctuated_nn_chinaclose Yes 0.4972 0.4984000 No
behave_nnopen_punctuated_nn_chinaclose Yes 0.2933 0.4721143 No
behave_nnclose_punctuated_nn_chinaclose Yes 0.2904 0.4721143 No
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.2260 0.4592013 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.2248 0.4592013 No
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.2209 0.4592013 No
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.2195 0.4592013 No
behave_divopen_punctuated_nn_chinaclose Yes 0.1510 0.3435750 No
behave_divclose_punctuated_nn_chinaclose Yes 0.1349 0.3164318 No
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.1208 0.2921344 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.1182 0.2921344 No
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.1109 0.2921344 No
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.1089 0.2921344 No
behave_nnopen_punctuated_nn_chinaopen Yes 0.2958 0.4721143 No
behave_nnclose_punctuated_nn_chinaopen Yes 0.2929 0.4721143 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.2281 0.4592013 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.2269 0.4592013 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.2230 0.4592013 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.2216 0.4592013 No
behave_divopen_punctuated_nn_chinaopen Yes 0.1527 0.3435750 No
behave_divclose_punctuated_nn_chinaopen Yes 0.1365 0.3164318 No
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.1222 0.2921344 No
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.1197 0.2921344 No
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.1122 0.2921344 No
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.1102 0.2921344 No
behave_nnclose_behave_nnopen Yes 0.4966 0.4984000 No
punctuated_nn_whoopen_behave_nnopen Yes 0.4174 0.4984000 No
punctuated_nn_whoclose_behave_nnopen Yes 0.4159 0.4984000 No
punctuated_nn_usaopen_behave_nnopen Yes 0.4108 0.4984000 No
punctuated_nn_usaclose_behave_nnopen Yes 0.4090 0.4984000 No
behave_divopen_behave_nnopen Yes 0.3127 0.4721143 No
behave_divclose_behave_nnopen Yes 0.2879 0.4721143 No
punctuacted_usaopen_behave_nnopen Yes 0.2652 0.4659545 No
punctuacted_usaclose_behave_nnopen Yes 0.2610 0.4659545 No
punctuacted_whoopen_behave_nnopen Yes 0.2489 0.4659545 No
punctuacted_whoclose_behave_nnopen Yes 0.2455 0.4659545 No
punctuated_nn_whoopen_behave_nnclose Yes 0.4207 0.4984000 No
punctuated_nn_whoclose_behave_nnclose Yes 0.4192 0.4984000 No
punctuated_nn_usaopen_behave_nnclose Yes 0.4141 0.4984000 No
punctuated_nn_usaclose_behave_nnclose Yes 0.4123 0.4984000 No
behave_divopen_behave_nnclose Yes 0.3157 0.4721143 No
behave_divclose_behave_nnclose Yes 0.2908 0.4721143 No
punctuacted_usaopen_behave_nnclose Yes 0.2680 0.4659545 No
punctuacted_usaclose_behave_nnclose Yes 0.2638 0.4659545 No
punctuacted_whoopen_behave_nnclose Yes 0.2516 0.4659545 No
punctuacted_whoclose_behave_nnclose Yes 0.2482 0.4659545 No
punctuated_nn_whoclose_punctuated_nn_whoopen Yes 0.4984 0.4984000 No
punctuated_nn_usaopen_punctuated_nn_whoopen Yes 0.4932 0.4984000 No
punctuated_nn_usaclose_punctuated_nn_whoopen Yes 0.4914 0.4984000 No
behave_divopen_punctuated_nn_whoopen Yes 0.3898 0.4984000 No
behave_divclose_punctuated_nn_whoopen Yes 0.3627 0.4887947 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.3377 0.4721143 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.3330 0.4721143 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.3193 0.4721143 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.3155 0.4721143 No
punctuated_nn_usaopen_punctuated_nn_whoclose Yes 0.4948 0.4984000 No
punctuated_nn_usaclose_punctuated_nn_whoclose Yes 0.4930 0.4984000 No
behave_divopen_punctuated_nn_whoclose Yes 0.3913 0.4984000 No
behave_divclose_punctuated_nn_whoclose Yes 0.3642 0.4887947 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.3391 0.4721143 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.3344 0.4721143 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.3207 0.4721143 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.3169 0.4721143 No
punctuated_nn_usaclose_punctuated_nn_usaopen Yes 0.4982 0.4984000 No
behave_divopen_punctuated_nn_usaopen Yes 0.3964 0.4984000 No
behave_divclose_punctuated_nn_usaopen Yes 0.3692 0.4892043 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.3439 0.4721143 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.3392 0.4721143 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.3254 0.4721143 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.3216 0.4721143 No
behave_divopen_punctuated_nn_usaclose Yes 0.3981 0.4984000 No
behave_divclose_punctuated_nn_usaclose Yes 0.3709 0.4892043 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.3456 0.4721143 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.3409 0.4721143 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.3271 0.4721143 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.3233 0.4721143 No
behave_divclose_behave_divopen Yes 0.4716 0.4984000 No
punctuacted_usaopen_behave_divopen Yes 0.4447 0.4984000 No
punctuacted_usaclose_behave_divopen Yes 0.4397 0.4984000 No
punctuacted_whoopen_behave_divopen Yes 0.4247 0.4984000 No
punctuacted_whoclose_behave_divopen Yes 0.4206 0.4984000 No
punctuacted_usaopen_behave_divclose Yes 0.4730 0.4984000 No
punctuacted_usaclose_behave_divclose Yes 0.4679 0.4984000 No
punctuacted_whoopen_behave_divclose Yes 0.4528 0.4984000 No
punctuacted_whoclose_behave_divclose Yes 0.4486 0.4984000 No
punctuacted_usaclose_punctuacted_usaopen Yes 0.4949 0.4984000 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.4797 0.4984000 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.4755 0.4984000 No
punctuacted_whoopen_punctuacted_usaclose Yes 0.4849 0.4984000 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.4806 0.4984000 No
punctuacted_whoclose_punctuacted_whoopen Yes 0.4958 0.4984000 No

Compare modelled to real data

mantel_res_GDAXI <- mantel_results_models(GDAXI_models_list,
                                          GDAXI_list,
                                          nperm,
                                          n_behave_models)

mantel_res_GDAXI$model <- rownames(mantel_res_GDAXI)
# order by increasing R
mantel_res_GDAXI <- mantel_res_GDAXI[order(mantel_res_GDAXI$r),]

mantel_res_GDAXI %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_convclose 1.000000 -0.1230175 1.0000000 behave_convclose
behave_convopen 1.000000 -0.1203879 1.0000000 behave_convopen
punctuated_nn_chinaclose 0.002997 0.0512232 0.0044955 punctuated_nn_chinaclose
punctuated_nn_chinaopen 0.001998 0.0523103 0.0032695 punctuated_nn_chinaopen
punctuacted_chinaopen 0.007992 0.0645632 0.0102754 punctuacted_chinaopen
punctuacted_chinaclose 0.003996 0.0672499 0.0055329 punctuacted_chinaclose
behave_divclose 0.017982 0.0830793 0.0202298 behave_divclose
behave_divopen 0.013986 0.0835362 0.0167832 behave_divopen
behave_nnclose 0.000999 0.0861029 0.0017982 behave_nnclose
behave_nnopen 0.000999 0.0889385 0.0017982 behave_nnopen
punctuated_nn_whoclose 0.000999 0.1245283 0.0017982 punctuated_nn_whoclose
punctuated_nn_usaclose 0.000999 0.1254534 0.0017982 punctuated_nn_usaclose
punctuated_nn_whoopen 0.000999 0.1259713 0.0017982 punctuated_nn_whoopen
punctuated_nn_usaopen 0.000999 0.1269814 0.0017982 punctuated_nn_usaopen
punctuacted_usaclose 0.000999 0.1970712 0.0017982 punctuacted_usaclose
punctuacted_usaopen 0.000999 0.1986824 0.0017982 punctuacted_usaopen
punctuacted_whoclose 0.000999 0.2078983 0.0017982 punctuacted_whoclose
punctuacted_whoopen 0.000999 0.2094143 0.0017982 punctuacted_whoopen

Compare resulting correlations

n1 <- nrow(GDAXI_df)
n2 <- nrow(GDAXI_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_GDAXI)){
  for (j in 1:nrow(mantel_res_GDAXI)){
  
  model_i <- mantel_res_GDAXI[i, "model"]
  model_j <- mantel_res_GDAXI[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_GDAXI[i, "r"]
  r_j <- mantel_res_GDAXI[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_GDAXI),
                        nrow(mantel_res_GDAXI))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_GDAXI$model
colnames(corr_p_matrix) <- mantel_res_GDAXI$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_GDAXI$model
colnames(binary_sig) <- mantel_res_GDAXI$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_GDAXI.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
GDAXI_row <- binary_sig[nrow(binary_sig),]
GDAXI_row <- data.frame(GDAXI_row)
GDAXI_high_names <- rownames(GDAXI_row)[GDAXI_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(GDAXI_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuated_nn_chinaclose, punctuated_nn_chinaopen, punctuacted_chinaopen, punctuacted_chinaclose, behave_divclose, behave_divopen, behave_nnclose, behave_nnopen, punctuated_nn_whoclose, punctuated_nn_usaclose, punctuated_nn_whoopen, punctuated_nn_usaopen, punctuacted_usaclose, punctuacted_usaopen, punctuacted_whoclose, punctuacted_whoopen"
GDAXI_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

GDAXI_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_convopen_behave_convclose Yes 0.4881 0.4980000 No
punctuated_nn_chinaclose_behave_convclose Yes 0.0255 0.1300500 No
punctuated_nn_chinaopen_behave_convclose Yes 0.0248 0.1300500 No
punctuacted_chinaopen_behave_convclose Yes 0.0178 0.1008667 No
punctuacted_chinaclose_behave_convclose Yes 0.0165 0.1008667 No
behave_divclose_behave_convclose Yes 0.0105 0.0720375 No
behave_divopen_behave_convclose Yes 0.0103 0.0720375 No
behave_nnclose_behave_convclose Yes 0.0096 0.0720375 No
behave_nnopen_behave_convclose Yes 0.0088 0.0720375 No
punctuated_nn_whoclose_behave_convclose Yes 0.0027 0.0286875 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0027 0.0286875 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0026 0.0286875 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0025 0.0286875 Yes
punctuacted_usaclose_behave_convclose Yes 2e-04 0.0038250 Yes
punctuacted_usaopen_behave_convclose Yes 1e-04 0.0030600 Yes
punctuacted_whoclose_behave_convclose Yes 1e-04 0.0030600 Yes
punctuacted_whoopen_behave_convclose Yes 1e-04 0.0030600 Yes
punctuated_nn_chinaclose_behave_convopen Yes 0.0273 0.1305281 No
punctuated_nn_chinaopen_behave_convopen Yes 0.0266 0.1305281 No
punctuacted_chinaopen_behave_convopen Yes 0.0192 0.1049143 No
punctuacted_chinaclose_behave_convopen Yes 0.0178 0.1008667 No
behave_divclose_behave_convopen Yes 0.0113 0.0720375 No
behave_divopen_behave_convopen Yes 0.0112 0.0720375 No
behave_nnclose_behave_convopen Yes 0.0104 0.0720375 No
behave_nnopen_behave_convopen Yes 0.0095 0.0720375 No
punctuated_nn_whoclose_behave_convopen Yes 0.0030 0.0286875 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0029 0.0286875 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0029 0.0286875 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0028 0.0286875 Yes
punctuacted_usaclose_behave_convopen Yes 2e-04 0.0038250 Yes
punctuacted_usaopen_behave_convopen Yes 2e-04 0.0038250 Yes
punctuacted_whoclose_behave_convopen Yes 1e-04 0.0030600 Yes
punctuacted_whoopen_behave_convopen Yes 1e-04 0.0030600 Yes
punctuated_nn_chinaopen_punctuated_nn_chinaclose Yes 0.4951 0.4980000 No
punctuacted_chinaopen_punctuated_nn_chinaclose Yes 0.4406 0.4980000 No
punctuacted_chinaclose_punctuated_nn_chinaclose Yes 0.4288 0.4980000 No
behave_divclose_punctuated_nn_chinaclose Yes 0.3605 0.4655025 No
behave_divopen_punctuated_nn_chinaclose Yes 0.3586 0.4655025 No
behave_nnclose_punctuated_nn_chinaclose Yes 0.3479 0.4628583 No
behave_nnopen_punctuated_nn_chinaclose Yes 0.3362 0.4611664 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.2048 0.3661448 No
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.2018 0.3661448 No
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.2002 0.3661448 No
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.1970 0.3661448 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.0489 0.1868786 No
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.0470 0.1868786 No
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.0374 0.1632000 No
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.0360 0.1632000 No
punctuacted_chinaopen_punctuated_nn_chinaopen Yes 0.4454 0.4980000 No
punctuacted_chinaclose_punctuated_nn_chinaopen Yes 0.4336 0.4980000 No
behave_divclose_punctuated_nn_chinaopen Yes 0.3651 0.4655025 No
behave_divopen_punctuated_nn_chinaopen Yes 0.3631 0.4655025 No
behave_nnclose_punctuated_nn_chinaopen Yes 0.3524 0.4648034 No
behave_nnopen_punctuated_nn_chinaopen Yes 0.3406 0.4611664 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.2082 0.3661448 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.2053 0.3661448 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.2036 0.3661448 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.2004 0.3661448 No
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.0501 0.1868786 No
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.0482 0.1868786 No
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.0384 0.1632000 No
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.0369 0.1632000 No
punctuacted_chinaclose_punctuacted_chinaopen Yes 0.4880 0.4980000 No
behave_divclose_punctuacted_chinaopen Yes 0.4177 0.4980000 No
behave_divopen_punctuacted_chinaopen Yes 0.4157 0.4980000 No
behave_nnclose_punctuacted_chinaopen Yes 0.4045 0.4980000 No
behave_nnopen_punctuacted_chinaopen Yes 0.3922 0.4959223 No
punctuated_nn_whoclose_punctuacted_chinaopen Yes 0.2497 0.4121129 No
punctuated_nn_usaclose_punctuacted_chinaopen Yes 0.2464 0.4121129 No
punctuated_nn_whoopen_punctuacted_chinaopen Yes 0.2446 0.4121129 No
punctuated_nn_usaopen_punctuacted_chinaopen Yes 0.2410 0.4121129 No
punctuacted_usaclose_punctuacted_chinaopen Yes 0.0659 0.2191891 No
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0636 0.2162400 No
punctuacted_whoclose_punctuacted_chinaopen Yes 0.0513 0.1868786 No
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0494 0.1868786 No
behave_divclose_punctuacted_chinaclose Yes 0.4295 0.4980000 No
behave_divopen_punctuacted_chinaclose Yes 0.4275 0.4980000 No
behave_nnclose_punctuacted_chinaclose Yes 0.4162 0.4980000 No
behave_nnopen_punctuacted_chinaclose Yes 0.4038 0.4980000 No
punctuated_nn_whoclose_punctuacted_chinaclose Yes 0.2594 0.4134188 No
punctuated_nn_usaclose_punctuacted_chinaclose Yes 0.2560 0.4122947 No
punctuated_nn_whoopen_punctuacted_chinaclose Yes 0.2541 0.4122947 No
punctuated_nn_usaopen_punctuacted_chinaclose Yes 0.2505 0.4121129 No
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0699 0.2228062 No
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0674 0.2194085 No
punctuacted_whoclose_punctuacted_chinaclose Yes 0.0545 0.1895114 No
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0526 0.1871581 No
behave_divopen_behave_divclose Yes 0.4980 0.4980000 No
behave_nnclose_behave_divclose Yes 0.4864 0.4980000 No
behave_nnopen_behave_divclose Yes 0.4737 0.4980000 No
punctuated_nn_whoclose_behave_divclose Yes 0.3200 0.4611664 No
punctuated_nn_usaclose_behave_divclose Yes 0.3163 0.4611664 No
punctuated_nn_whoopen_behave_divclose Yes 0.3142 0.4611664 No
punctuated_nn_usaopen_behave_divclose Yes 0.3102 0.4611664 No
punctuacted_usaclose_behave_divclose Yes 0.0970 0.2496450 No
punctuacted_usaopen_behave_divclose Yes 0.0938 0.2496450 No
punctuacted_whoclose_behave_divclose Yes 0.0771 0.2289115 No
punctuacted_whoopen_behave_divclose Yes 0.0746 0.2289115 No
behave_nnclose_behave_divopen Yes 0.4885 0.4980000 No
behave_nnopen_behave_divopen Yes 0.4758 0.4980000 No
punctuated_nn_whoclose_behave_divopen Yes 0.3219 0.4611664 No
punctuated_nn_usaclose_behave_divopen Yes 0.3181 0.4611664 No
punctuated_nn_whoopen_behave_divopen Yes 0.3160 0.4611664 No
punctuated_nn_usaopen_behave_divopen Yes 0.3120 0.4611664 No
punctuacted_usaclose_behave_divopen Yes 0.0979 0.2496450 No
punctuacted_usaopen_behave_divopen Yes 0.0947 0.2496450 No
punctuacted_whoclose_behave_divopen Yes 0.0778 0.2289115 No
punctuacted_whoopen_behave_divopen Yes 0.0753 0.2289115 No
behave_nnopen_behave_nnclose Yes 0.4873 0.4980000 No
punctuated_nn_whoclose_behave_nnclose Yes 0.3323 0.4611664 No
punctuated_nn_usaclose_behave_nnclose Yes 0.3285 0.4611664 No
punctuated_nn_whoopen_behave_nnclose Yes 0.3264 0.4611664 No
punctuated_nn_usaopen_behave_nnclose Yes 0.3222 0.4611664 No
punctuacted_usaclose_behave_nnclose Yes 0.1029 0.2539306 No
punctuacted_usaopen_behave_nnclose Yes 0.0996 0.2498164 No
punctuacted_whoclose_behave_nnclose Yes 0.0821 0.2326167 No
punctuacted_whoopen_behave_nnclose Yes 0.0795 0.2295000 No
punctuated_nn_whoclose_behave_nnopen Yes 0.3439 0.4615500 No
punctuated_nn_usaclose_behave_nnopen Yes 0.3401 0.4611664 No
punctuated_nn_whoopen_behave_nnopen Yes 0.3379 0.4611664 No
punctuated_nn_usaopen_behave_nnopen Yes 0.3338 0.4611664 No
punctuacted_usaclose_behave_nnopen Yes 0.1088 0.2601000 No
punctuacted_usaopen_behave_nnopen Yes 0.1053 0.2557286 No
punctuacted_whoclose_behave_nnopen Yes 0.0871 0.2379696 No
punctuacted_whoopen_behave_nnopen Yes 0.0843 0.2345073 No
punctuated_nn_usaclose_punctuated_nn_whoclose Yes 0.4958 0.4980000 No
punctuated_nn_whoopen_punctuated_nn_whoclose Yes 0.4935 0.4980000 No
punctuated_nn_usaopen_punctuated_nn_whoclose Yes 0.4889 0.4980000 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.2029 0.3661448 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.1977 0.3661448 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.1692 0.3661448 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.1648 0.3661448 No
punctuated_nn_whoopen_punctuated_nn_usaclose Yes 0.4977 0.4980000 No
punctuated_nn_usaopen_punctuated_nn_usaclose Yes 0.4931 0.4980000 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.2059 0.3661448 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.2006 0.3661448 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.1719 0.3661448 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.1674 0.3661448 No
punctuated_nn_usaopen_punctuated_nn_whoopen Yes 0.4954 0.4980000 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.2075 0.3661448 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.2022 0.3661448 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.1734 0.3661448 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.1689 0.3661448 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.2108 0.3665045 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.2055 0.3661448 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.1763 0.3661448 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.1718 0.3661448 No
punctuacted_usaopen_punctuacted_usaclose Yes 0.4925 0.4980000 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.4499 0.4980000 No
punctuacted_whoopen_punctuacted_usaclose Yes 0.4429 0.4980000 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.4573 0.4980000 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.4503 0.4980000 No
punctuacted_whoopen_punctuacted_whoclose Yes 0.4929 0.4980000 No

Compared modelled to real data

mantel_res_FTSEMIB.MI <- mantel_results_models(FTSEMIB.MI_models_list,
                                          FTSEMIB.MI_list,
                                          nperm,
                                          n_behave_models)
mantel_res_FTSEMIB.MI$model <- rownames(mantel_res_FTSEMIB.MI)

# order by increasing R
mantel_res_FTSEMIB.MI <- mantel_res_FTSEMIB.MI[order(mantel_res_FTSEMIB.MI$r),]

mantel_res_FTSEMIB.MI %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_convopen 0.013986 0.0588349 0.0139860 behave_convopen
behave_convclose 0.012987 0.0652538 0.0137510 behave_convclose
behave_divclose 0.002997 0.0698259 0.0033716 behave_divclose
behave_divopen 0.001998 0.0787428 0.0023976 behave_divopen
punctuacted_chinaopen 0.000999 0.3415321 0.0012844 punctuacted_chinaopen
punctuacted_chinaclose 0.000999 0.3540740 0.0012844 punctuacted_chinaclose
punctuated_nn_chinaopen 0.000999 0.4947322 0.0012844 punctuated_nn_chinaopen
punctuated_nn_chinaclose 0.000999 0.4990044 0.0012844 punctuated_nn_chinaclose
behave_nnopen 0.000999 0.5018563 0.0012844 behave_nnopen
behave_nnclose 0.000999 0.5024039 0.0012844 behave_nnclose
punctuated_nn_usaopen 0.000999 0.5726162 0.0012844 punctuated_nn_usaopen
punctuated_nn_whoopen 0.000999 0.5727606 0.0012844 punctuated_nn_whoopen
punctuated_nn_usaclose 0.000999 0.5731691 0.0012844 punctuated_nn_usaclose
punctuated_nn_whoclose 0.000999 0.5737623 0.0012844 punctuated_nn_whoclose
punctuacted_usaclose 0.000999 0.6355037 0.0012844 punctuacted_usaclose
punctuacted_usaopen 0.000999 0.6388375 0.0012844 punctuacted_usaopen
punctuacted_whoclose 0.000999 0.6444609 0.0012844 punctuacted_whoclose
punctuacted_whoopen 0.000999 0.6458831 0.0012844 punctuacted_whoopen

Compare resulting R values

n1 <- nrow(FTSEMIB.MI_df)
n2 <- nrow(FTSEMIB.MI_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_FTSEMIB.MI)){
  for (j in 1:nrow(mantel_res_FTSEMIB.MI)){
  
  model_i <- mantel_res_FTSEMIB.MI[i, "model"]
  model_j <- mantel_res_FTSEMIB.MI[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_FTSEMIB.MI[i, "r"]
  r_j <- mantel_res_FTSEMIB.MI[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_FTSEMIB.MI),
                        nrow(mantel_res_FTSEMIB.MI))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_FTSEMIB.MI$model
colnames(corr_p_matrix) <- mantel_res_FTSEMIB.MI$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_FTSEMIB.MI$model
colnames(binary_sig) <- mantel_res_FTSEMIB.MI$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_FTSEMIB.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
FTSEMIB.MI_row <- binary_sig[nrow(binary_sig),]
FTSEMIB.MI_row <- data.frame(FTSEMIB.MI_row)
FTSEMIB.MI_high_names <- rownames(FTSEMIB.MI_row)[FTSEMIB.MI_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(FTSEMIB.MI_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuated_nn_usaopen, punctuated_nn_whoopen, punctuated_nn_usaclose, punctuated_nn_whoclose, punctuacted_usaclose, punctuacted_usaopen, punctuacted_whoclose, punctuacted_whoopen"
FTSEMIB.MI_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

FTSEMIB.MI_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_convclose_behave_convopen Yes 0.4713 0.4990000 No
behave_divclose_behave_convopen Yes 0.4509 0.4990000 No
behave_divopen_behave_convopen Yes 0.4115 0.4880581 No
punctuacted_chinaopen_behave_convopen Yes 5e-04 0.0011953 Yes
punctuacted_chinaclose_behave_convopen Yes 3e-04 0.0007914 Yes
punctuated_nn_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_divclose_behave_convclose Yes 0.4795 0.4990000 No
behave_divopen_behave_convclose Yes 0.4398 0.4990000 No
punctuacted_chinaopen_behave_convclose Yes 6e-04 0.0013909 Yes
punctuacted_chinaclose_behave_convclose Yes 3e-04 0.0007914 Yes
punctuated_nn_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_divopen_behave_divclose Yes 0.4601 0.4990000 No
punctuacted_chinaopen_behave_divclose Yes 7e-04 0.0015985 Yes
punctuacted_chinaclose_behave_divclose Yes 4e-04 0.0010200 Yes
punctuated_nn_chinaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaopen_behave_divopen Yes 0.0010 0.0021250 Yes
punctuacted_chinaclose_behave_divopen Yes 6e-04 0.0013909 Yes
punctuated_nn_chinaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_punctuacted_chinaopen Yes 0.4366 0.4990000 No
punctuated_nn_chinaopen_punctuacted_chinaopen Yes 0.0185 0.0307663 Yes
punctuated_nn_chinaclose_punctuacted_chinaopen Yes 0.0158 0.0265648 Yes
behave_nnopen_punctuacted_chinaopen Yes 0.0142 0.0241400 Yes
behave_nnclose_punctuacted_chinaopen Yes 0.0139 0.0238955 Yes
punctuated_nn_usaopen_punctuacted_chinaopen Yes 5e-04 0.0011953 Yes
punctuated_nn_whoopen_punctuacted_chinaopen Yes 5e-04 0.0011953 Yes
punctuated_nn_usaclose_punctuacted_chinaopen Yes 5e-04 0.0011953 Yes
punctuated_nn_whoclose_punctuacted_chinaopen Yes 4e-04 0.0010200 Yes
punctuacted_usaclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_punctuacted_chinaclose Yes 0.0271 0.0431906 Yes
punctuated_nn_chinaclose_punctuacted_chinaclose Yes 0.0234 0.0376863 Yes
behave_nnopen_punctuacted_chinaclose Yes 0.0211 0.0343436 Yes
behave_nnclose_punctuacted_chinaclose Yes 0.0207 0.0340548 Yes
punctuated_nn_usaopen_punctuacted_chinaclose Yes 8e-04 0.0017239 Yes
punctuated_nn_whoopen_punctuacted_chinaclose Yes 8e-04 0.0017239 Yes
punctuated_nn_usaclose_punctuacted_chinaclose Yes 8e-04 0.0017239 Yes
punctuated_nn_whoclose_punctuacted_chinaclose Yes 8e-04 0.0017239 Yes
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_punctuated_nn_chinaopen Yes 0.4747 0.4990000 No
behave_nnopen_punctuated_nn_chinaopen Yes 0.4578 0.4990000 No
behave_nnclose_punctuated_nn_chinaopen Yes 0.4546 0.4990000 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.1113 0.1576750 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.1108 0.1576750 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.1095 0.1576750 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.1077 0.1569343 No
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.0099 0.0184337 Yes
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.0084 0.0160650 Yes
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.0062 0.0128189 Yes
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.0058 0.0121562 Yes
behave_nnopen_punctuated_nn_chinaclose Yes 0.4830 0.4990000 No
behave_nnclose_punctuated_nn_chinaclose Yes 0.4798 0.4990000 No
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.1238 0.1632000 No
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.1233 0.1632000 No
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.1219 0.1632000 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.1199 0.1632000 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.0117 0.0208151 Yes
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.0100 0.0184337 Yes
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.0074 0.0148974 Yes
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.0069 0.0140760 Yes
behave_nnclose_behave_nnopen Yes 0.4967 0.4990000 No
punctuated_nn_usaopen_behave_nnopen Yes 0.1327 0.1632000 No
punctuated_nn_whoopen_behave_nnopen Yes 0.1322 0.1632000 No
punctuated_nn_usaclose_behave_nnopen Yes 0.1307 0.1632000 No
punctuated_nn_whoclose_behave_nnopen Yes 0.1286 0.1632000 No
punctuacted_usaclose_behave_nnopen Yes 0.0131 0.0230379 Yes
punctuacted_usaopen_behave_nnopen Yes 0.0111 0.0202179 Yes
punctuacted_whoclose_behave_nnopen Yes 0.0084 0.0160650 Yes
punctuacted_whoopen_behave_nnopen Yes 0.0078 0.0154962 Yes
punctuated_nn_usaopen_behave_nnclose Yes 0.1344 0.1632000 No
punctuated_nn_whoopen_behave_nnclose Yes 0.1339 0.1632000 No
punctuated_nn_usaclose_behave_nnclose Yes 0.1325 0.1632000 No
punctuated_nn_whoclose_behave_nnclose Yes 0.1304 0.1632000 No
punctuacted_usaclose_behave_nnclose Yes 0.0134 0.0232977 Yes
punctuacted_usaopen_behave_nnclose Yes 0.0114 0.0205200 Yes
punctuacted_whoclose_behave_nnclose Yes 0.0086 0.0162444 Yes
punctuacted_whoopen_behave_nnclose Yes 0.0079 0.0154962 Yes
punctuated_nn_whoopen_punctuated_nn_usaopen Yes 0.4990 0.4990000 No
punctuated_nn_usaclose_punctuated_nn_usaopen Yes 0.4963 0.4990000 No
punctuated_nn_whoclose_punctuated_nn_usaopen Yes 0.4924 0.4990000 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.1337 0.1632000 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.1207 0.1632000 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.1005 0.1513500 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.0958 0.1501898 No
punctuated_nn_usaclose_punctuated_nn_whoopen Yes 0.4973 0.4990000 No
punctuated_nn_whoclose_punctuated_nn_whoopen Yes 0.4933 0.4990000 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.1342 0.1632000 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.1211 0.1632000 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.1009 0.1513500 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.0962 0.1501898 No
punctuated_nn_whoclose_punctuated_nn_usaclose Yes 0.4961 0.4990000 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.1357 0.1634811 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.1225 0.1632000 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.1022 0.1518117 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.0974 0.1505273 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.1379 0.1648336 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.1245 0.1632000 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.1039 0.1528529 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.0991 0.1513500 No
punctuacted_usaopen_punctuacted_usaclose Yes 0.4750 0.4990000 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.4327 0.4990000 No
punctuacted_whoopen_punctuacted_usaclose Yes 0.4220 0.4966615 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.4574 0.4990000 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.4467 0.4990000 No
punctuacted_whoopen_punctuacted_whoclose Yes 0.4891 0.4990000 No

Compared modelled to real data

mantel_res_FCHI <- mantel_results_models(FCHI_models_list,
                                          FCHI_list,
                                          nperm,
                                          n_behave_models)
mantel_res_FCHI$model <- rownames(mantel_res_FCHI)

# order by increasing R
mantel_res_FCHI <- mantel_res_FCHI[order(mantel_res_FCHI$r),]

mantel_res_FCHI %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_divclose 0.001998 0.0670484 0.0021155 behave_divclose
behave_divopen 0.003996 0.0703231 0.0039960 behave_divopen
behave_convopen 0.000999 0.1024543 0.0011239 behave_convopen
behave_convclose 0.000999 0.1040130 0.0011239 behave_convclose
punctuacted_chinaopen 0.000999 0.3887988 0.0011239 punctuacted_chinaopen
punctuacted_chinaclose 0.000999 0.3941594 0.0011239 punctuacted_chinaclose
behave_nnclose 0.000999 0.5567168 0.0011239 behave_nnclose
behave_nnopen 0.000999 0.5577135 0.0011239 behave_nnopen
punctuated_nn_chinaopen 0.000999 0.5592017 0.0011239 punctuated_nn_chinaopen
punctuated_nn_chinaclose 0.000999 0.5599477 0.0011239 punctuated_nn_chinaclose
punctuated_nn_usaclose 0.000999 0.6311865 0.0011239 punctuated_nn_usaclose
punctuated_nn_usaopen 0.000999 0.6317077 0.0011239 punctuated_nn_usaopen
punctuated_nn_whoclose 0.000999 0.6320874 0.0011239 punctuated_nn_whoclose
punctuated_nn_whoopen 0.000999 0.6324441 0.0011239 punctuated_nn_whoopen
punctuacted_usaclose 0.000999 0.6908659 0.0011239 punctuacted_usaclose
punctuacted_usaopen 0.000999 0.6931904 0.0011239 punctuacted_usaopen
punctuacted_whoclose 0.000999 0.7015777 0.0011239 punctuacted_whoclose
punctuacted_whoopen 0.000999 0.7031929 0.0011239 punctuacted_whoopen

Compare resulting R values

n1 <- nrow(FCHI_df)
n2 <- nrow(FCHI_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_FCHI)){
  for (j in 1:nrow(mantel_res_FCHI)){
  
  model_i <- mantel_res_FCHI[i, "model"]
  model_j <- mantel_res_FCHI[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_FCHI[i, "r"]
  r_j <- mantel_res_FCHI[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_FCHI),
                        nrow(mantel_res_FCHI))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_FCHI$model
colnames(corr_p_matrix) <- mantel_res_FCHI$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_FCHI$model
colnames(binary_sig) <- mantel_res_FCHI$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_FCHI.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
FCHI_row <- binary_sig[nrow(binary_sig),]
FCHI_row <- data.frame(FCHI_row)
FCHI_high_names <- rownames(FCHI_row)[FCHI_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(FCHI_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuated_nn_usaclose, punctuated_nn_usaopen, punctuated_nn_whoclose, punctuated_nn_whoopen, punctuacted_usaclose, punctuacted_usaopen, punctuacted_whoclose, punctuacted_whoopen"
FCHI_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

FCHI_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_divopen_behave_divclose Yes 0.4852 0.4973000 No
behave_convopen_behave_divclose Yes 0.3442 0.4050969 No
behave_convclose_behave_divclose Yes 0.3377 0.4005279 No
punctuacted_chinaopen_behave_divclose Yes 1e-04 0.0002250 Yes
punctuacted_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_convopen_behave_divopen Yes 0.3579 0.4148386 No
behave_convclose_behave_divopen Yes 0.3513 0.4102969 No
punctuacted_chinaopen_behave_divopen Yes 1e-04 0.0002250 Yes
punctuacted_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_convclose_behave_convopen Yes 0.4929 0.4973000 No
punctuacted_chinaopen_behave_convopen Yes 3e-04 0.0006375 Yes
punctuacted_chinaclose_behave_convopen Yes 2e-04 0.0004371 Yes
behave_nnclose_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaopen_behave_convclose Yes 3e-04 0.0006375 Yes
punctuacted_chinaclose_behave_convclose Yes 2e-04 0.0004371 Yes
behave_nnclose_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_punctuacted_chinaopen Yes 0.4716 0.4973000 No
behave_nnclose_punctuacted_chinaopen Yes 0.0072 0.0121055 Yes
behave_nnopen_punctuacted_chinaopen Yes 0.0069 0.0118618 Yes
punctuated_nn_chinaopen_punctuacted_chinaopen Yes 0.0064 0.0112552 Yes
punctuated_nn_chinaclose_punctuacted_chinaopen Yes 0.0062 0.0112552 Yes
punctuated_nn_usaclose_punctuacted_chinaopen Yes 1e-04 0.0002250 Yes
punctuated_nn_usaopen_punctuacted_chinaopen Yes 1e-04 0.0002250 Yes
punctuated_nn_whoclose_punctuacted_chinaopen Yes 1e-04 0.0002250 Yes
punctuated_nn_whoopen_punctuacted_chinaopen Yes 1e-04 0.0002250 Yes
punctuacted_usaclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
behave_nnclose_punctuacted_chinaclose Yes 0.0087 0.0138656 Yes
behave_nnopen_punctuacted_chinaclose Yes 0.0083 0.0133674 Yes
punctuated_nn_chinaopen_punctuacted_chinaclose Yes 0.0078 0.0126957 Yes
punctuated_nn_chinaclose_punctuacted_chinaclose Yes 0.0076 0.0125032 Yes
punctuated_nn_usaclose_punctuacted_chinaclose Yes 1e-04 0.0002250 Yes
punctuated_nn_usaopen_punctuacted_chinaclose Yes 1e-04 0.0002250 Yes
punctuated_nn_whoclose_punctuacted_chinaclose Yes 1e-04 0.0002250 Yes
punctuated_nn_whoopen_punctuacted_chinaclose Yes 1e-04 0.0002250 Yes
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_nnclose Yes 0.4935 0.4973000 No
punctuated_nn_chinaopen_behave_nnclose Yes 0.4838 0.4973000 No
punctuated_nn_chinaclose_behave_nnclose Yes 0.4789 0.4973000 No
punctuated_nn_usaclose_behave_nnclose Yes 0.0973 0.1348714 No
punctuated_nn_usaopen_behave_nnclose Yes 0.0956 0.1348714 No
punctuated_nn_whoclose_behave_nnclose Yes 0.0944 0.1348714 No
punctuated_nn_whoopen_behave_nnclose Yes 0.0933 0.1348714 No
punctuacted_usaclose_behave_nnclose Yes 0.0064 0.0112552 Yes
punctuacted_usaopen_behave_nnclose Yes 0.0055 0.0103889 Yes
punctuacted_whoclose_behave_nnclose Yes 0.0032 0.0065280 Yes
punctuacted_whoopen_behave_nnclose Yes 0.0029 0.0060781 Yes
punctuated_nn_chinaopen_behave_nnopen Yes 0.4903 0.4973000 No
punctuated_nn_chinaclose_behave_nnopen Yes 0.4854 0.4973000 No
punctuated_nn_usaclose_behave_nnopen Yes 0.1001 0.1348714 No
punctuated_nn_usaopen_behave_nnopen Yes 0.0984 0.1348714 No
punctuated_nn_whoclose_behave_nnopen Yes 0.0972 0.1348714 No
punctuated_nn_whoopen_behave_nnopen Yes 0.0961 0.1348714 No
punctuacted_usaclose_behave_nnopen Yes 0.0067 0.0116489 Yes
punctuacted_usaopen_behave_nnopen Yes 0.0058 0.0108220 Yes
punctuacted_whoclose_behave_nnopen Yes 0.0034 0.0066692 Yes
punctuacted_whoopen_behave_nnopen Yes 0.0030 0.0062027 Yes
punctuated_nn_chinaclose_punctuated_nn_chinaopen Yes 0.4951 0.4973000 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.1045 0.1348714 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.1027 0.1348714 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.1014 0.1348714 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.1003 0.1348714 No
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.0071 0.0120700 Yes
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.0062 0.0112552 Yes
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.0036 0.0069722 Yes
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.0033 0.0066434 Yes
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.1067 0.1349182 No
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.1049 0.1348714 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.1036 0.1348714 No
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.1024 0.1348714 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.0074 0.0123065 Yes
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.0064 0.0112552 Yes
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.0038 0.0072675 Yes
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.0034 0.0066692 Yes
punctuated_nn_usaopen_punctuated_nn_usaclose Yes 0.4961 0.4973000 No
punctuated_nn_whoclose_punctuated_nn_usaclose Yes 0.4933 0.4973000 No
punctuated_nn_whoopen_punctuated_nn_usaclose Yes 0.4906 0.4973000 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.1161 0.1421064 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.1066 0.1349182 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.0766 0.1160376 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.0715 0.1127784 No
punctuated_nn_whoclose_punctuated_nn_usaopen Yes 0.4972 0.4973000 No
punctuated_nn_whoopen_punctuated_nn_usaopen Yes 0.4945 0.4973000 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.1180 0.1432857 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.1084 0.1359443 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.0780 0.1170000 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.0729 0.1138133 No
punctuated_nn_whoopen_punctuated_nn_whoclose Yes 0.4973 0.4973000 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.1194 0.1438441 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.1097 0.1364561 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.0790 0.1173495 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.0739 0.1142091 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.1208 0.1443938 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.1110 0.1369597 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.0800 0.1176923 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.0748 0.1144440 No
punctuacted_usaopen_punctuacted_usaclose Yes 0.4800 0.4973000 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.4076 0.4653940 No
punctuacted_whoopen_punctuacted_usaclose Yes 0.3937 0.4529030 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.4271 0.4804875 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.4131 0.4681800 No
punctuacted_whoopen_punctuacted_whoclose Yes 0.4857 0.4973000 No

Compared modelled to real data

mantel_res_AXJO <- mantel_results_models(AXJO_models_list,
                                          AXJO_list,
                                          nperm,
                                          n_behave_models)
mantel_res_AXJO$model <- rownames(mantel_res_AXJO)

# order by increasing R
mantel_res_AXJO <- mantel_res_AXJO[order(mantel_res_AXJO$r),]

mantel_res_AXJO %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_convopen 0.2317682 0.0211062 0.2317682 behave_convopen
behave_convclose 0.1458541 0.0296052 0.1544338 behave_convclose
behave_divclose 0.0009990 0.1160205 0.0011239 behave_divclose
behave_divopen 0.0009990 0.1271245 0.0011239 behave_divopen
punctuacted_chinaopen 0.0009990 0.3869140 0.0011239 punctuacted_chinaopen
punctuacted_chinaclose 0.0009990 0.4003584 0.0011239 punctuacted_chinaclose
punctuated_nn_chinaopen 0.0009990 0.5121504 0.0011239 punctuated_nn_chinaopen
behave_nnopen 0.0009990 0.5153699 0.0011239 behave_nnopen
behave_nnclose 0.0009990 0.5165877 0.0011239 behave_nnclose
punctuated_nn_chinaclose 0.0009990 0.5172837 0.0011239 punctuated_nn_chinaclose
punctuated_nn_whoopen 0.0009990 0.5997349 0.0011239 punctuated_nn_whoopen
punctuated_nn_usaopen 0.0009990 0.6005835 0.0011239 punctuated_nn_usaopen
punctuated_nn_whoclose 0.0009990 0.6010498 0.0011239 punctuated_nn_whoclose
punctuated_nn_usaclose 0.0009990 0.6013874 0.0011239 punctuated_nn_usaclose
punctuacted_usaclose 0.0009990 0.6635678 0.0011239 punctuacted_usaclose
punctuacted_usaopen 0.0009990 0.6671247 0.0011239 punctuacted_usaopen
punctuacted_whoclose 0.0009990 0.6736374 0.0011239 punctuacted_whoclose
punctuacted_whoopen 0.0009990 0.6749587 0.0011239 punctuacted_whoopen

Compare resulting R values

n1 <- nrow(AXJO_df)
n2 <- nrow(AXJO_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_AXJO)){
  for (j in 1:nrow(mantel_res_AXJO)){
  
  model_i <- mantel_res_AXJO[i, "model"]
  model_j <- mantel_res_AXJO[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_AXJO[i, "r"]
  r_j <- mantel_res_AXJO[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_AXJO),
                        nrow(mantel_res_AXJO))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_AXJO$model
colnames(corr_p_matrix) <- mantel_res_AXJO$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_AXJO$model
colnames(binary_sig) <- mantel_res_AXJO$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_AXJO.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
AXJO_row <- binary_sig[nrow(binary_sig),]
AXJO_row <- data.frame(AXJO_row)
AXJO_high_names <- rownames(AXJO_row)[AXJO_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(AXJO_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuated_nn_whoopen, punctuated_nn_usaopen, punctuated_nn_whoclose, punctuated_nn_usaclose, punctuacted_usaclose, punctuacted_usaopen, punctuacted_whoclose, punctuacted_whoopen"
AXJO_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

AXJO_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_convclose_behave_convopen Yes 0.4620 0.4976000 No
behave_divclose_behave_convopen Yes 0.1420 0.1658473 No
behave_divopen_behave_convopen Yes 0.1155 0.1409786 No
punctuacted_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_divclose_behave_convclose Yes 0.1646 0.1907864 No
behave_divopen_behave_convclose Yes 0.1352 0.1591200 No
punctuacted_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_divopen_behave_divclose Yes 0.4497 0.4976000 No
punctuacted_chinaopen_behave_divclose Yes 5e-04 0.0012143 Yes
punctuacted_chinaclose_behave_divclose Yes 3e-04 0.0007525 Yes
punctuated_nn_chinaopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaopen_behave_divopen Yes 8e-04 0.0018000 Yes
punctuacted_chinaclose_behave_divopen Yes 4e-04 0.0009871 Yes
punctuated_nn_chinaopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_punctuacted_chinaopen Yes 0.4291 0.4863133 No
punctuated_nn_chinaopen_punctuacted_chinaopen Yes 0.0386 0.0641935 No
behave_nnopen_punctuacted_chinaopen Yes 0.0346 0.0581736 No
behave_nnclose_punctuacted_chinaopen Yes 0.0332 0.0564400 No
punctuated_nn_chinaclose_punctuacted_chinaopen Yes 0.0324 0.0556989 No
punctuated_nn_whoopen_punctuacted_chinaopen Yes 7e-04 0.0015985 Yes
punctuated_nn_usaopen_punctuacted_chinaopen Yes 7e-04 0.0015985 Yes
punctuated_nn_whoclose_punctuacted_chinaopen Yes 6e-04 0.0014123 Yes
punctuated_nn_usaclose_punctuacted_chinaopen Yes 6e-04 0.0014123 Yes
punctuacted_usaclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_punctuacted_chinaclose Yes 0.0560 0.0892500 No
behave_nnopen_punctuacted_chinaclose Yes 0.0507 0.0816537 No
behave_nnclose_punctuacted_chinaclose Yes 0.0488 0.0794298 No
punctuated_nn_chinaclose_punctuacted_chinaclose Yes 0.0477 0.0784742 No
punctuated_nn_whoopen_punctuacted_chinaclose Yes 0.0013 0.0027625 Yes
punctuated_nn_usaopen_punctuacted_chinaclose Yes 0.0012 0.0025859 Yes
punctuated_nn_whoclose_punctuacted_chinaclose Yes 0.0012 0.0025859 Yes
punctuated_nn_usaclose_punctuacted_chinaclose Yes 0.0012 0.0025859 Yes
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0000 0.0000000 Yes
behave_nnopen_punctuated_nn_chinaopen Yes 0.4804 0.4976000 No
behave_nnclose_punctuated_nn_chinaopen Yes 0.4730 0.4976000 No
punctuated_nn_chinaclose_punctuated_nn_chinaopen Yes 0.4688 0.4976000 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.0768 0.1115462 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.0747 0.1115462 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.0736 0.1115462 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.0727 0.1115462 No
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.0044 0.0080143 Yes
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.0035 0.0066111 Yes
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.0024 0.0049622 Yes
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.0022 0.0046110 Yes
behave_nnclose_behave_nnopen Yes 0.4926 0.4976000 No
punctuated_nn_chinaclose_behave_nnopen Yes 0.4883 0.4976000 No
punctuated_nn_whoopen_behave_nnopen Yes 0.0842 0.1115462 No
punctuated_nn_usaopen_behave_nnopen Yes 0.0819 0.1115462 No
punctuated_nn_whoclose_behave_nnopen Yes 0.0807 0.1115462 No
punctuated_nn_usaclose_behave_nnopen Yes 0.0798 0.1115462 No
punctuacted_usaclose_behave_nnopen Yes 0.0051 0.0090733 Yes
punctuacted_usaopen_behave_nnopen Yes 0.0041 0.0076500 Yes
punctuacted_whoclose_behave_nnopen Yes 0.0027 0.0053649 Yes
punctuacted_whoopen_behave_nnopen Yes 0.0025 0.0051000 Yes
punctuated_nn_chinaclose_behave_nnclose Yes 0.4957 0.4976000 No
punctuated_nn_whoopen_behave_nnclose Yes 0.0871 0.1119857 No
punctuated_nn_usaopen_behave_nnclose Yes 0.0848 0.1115462 No
punctuated_nn_whoclose_behave_nnclose Yes 0.0835 0.1115462 No
punctuated_nn_usaclose_behave_nnclose Yes 0.0826 0.1115462 No
punctuacted_usaclose_behave_nnclose Yes 0.0053 0.0093207 Yes
punctuacted_usaopen_behave_nnclose Yes 0.0043 0.0079265 Yes
punctuacted_whoclose_behave_nnclose Yes 0.0029 0.0056165 Yes
punctuacted_whoopen_behave_nnclose Yes 0.0027 0.0053649 Yes
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.0888 0.1132200 No
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.0864 0.1119857 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.0851 0.1115462 No
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.0842 0.1115462 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.0055 0.0095625 Yes
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.0045 0.0081000 Yes
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.0030 0.0057375 Yes
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.0028 0.0054923 Yes
punctuated_nn_usaopen_punctuated_nn_whoopen Yes 0.4941 0.4976000 No
punctuated_nn_whoclose_punctuated_nn_whoopen Yes 0.4908 0.4976000 No
punctuated_nn_usaclose_punctuated_nn_whoopen Yes 0.4884 0.4976000 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.1161 0.1409786 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.1027 0.1298603 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.0809 0.1115462 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.0769 0.1115462 No
punctuated_nn_whoclose_punctuated_nn_usaopen Yes 0.4967 0.4976000 No
punctuated_nn_usaclose_punctuated_nn_usaopen Yes 0.4944 0.4976000 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.1190 0.1433622 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.1054 0.1321820 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.0832 0.1115462 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.0791 0.1115462 No
punctuated_nn_usaclose_punctuated_nn_whoclose Yes 0.4976 0.4976000 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.1207 0.1442742 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.1069 0.1329732 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.0844 0.1115462 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.0803 0.1115462 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.1219 0.1445791 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.1080 0.1332581 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.0853 0.1115462 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.0812 0.1115462 No
punctuacted_usaopen_punctuacted_usaclose Yes 0.4714 0.4976000 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.4190 0.4784104 No
punctuacted_whoopen_punctuacted_usaclose Yes 0.4084 0.4698135 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.4472 0.4976000 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.4365 0.4910625 No
punctuacted_whoopen_punctuacted_whoclose Yes 0.4892 0.4976000 No

Compared modelled to real data

mantel_res_HSI <- mantel_results_models(HSI_models_list,
                                          HSI_list,
                                          nperm,
                                          n_behave_models)
mantel_res_HSI$model <- rownames(mantel_res_HSI)
# order by increasing R
mantel_res_HSI <- mantel_res_HSI[order(mantel_res_HSI$r),]

mantel_res_HSI %>% knitr::kable(format = "html") %>% kable_styling()
p_value r p_value_adjusted model
behave_divclose 0.3116883 0.0158237 0.3116883 behave_divclose
behave_divopen 0.2447552 0.0226616 0.2591526 behave_divopen
behave_convopen 0.0199800 0.0617672 0.0224775 behave_convopen
behave_convclose 0.0059940 0.0784762 0.0071928 behave_convclose
punctuacted_chinaopen 0.0009990 0.3285903 0.0012844 punctuacted_chinaopen
punctuacted_chinaclose 0.0009990 0.3459060 0.0012844 punctuacted_chinaclose
behave_nnopen 0.0009990 0.3914384 0.0012844 behave_nnopen
punctuated_nn_chinaopen 0.0009990 0.4111655 0.0012844 punctuated_nn_chinaopen
behave_nnclose 0.0009990 0.4132385 0.0012844 behave_nnclose
punctuated_nn_chinaclose 0.0009990 0.4352474 0.0012844 punctuated_nn_chinaclose
punctuated_nn_usaopen 0.0009990 0.4574210 0.0012844 punctuated_nn_usaopen
punctuated_nn_whoopen 0.0009990 0.4592989 0.0012844 punctuated_nn_whoopen
punctuated_nn_usaclose 0.0009990 0.4797498 0.0012844 punctuated_nn_usaclose
punctuated_nn_whoclose 0.0009990 0.4818334 0.0012844 punctuated_nn_whoclose
punctuacted_usaopen 0.0009990 0.5410522 0.0012844 punctuacted_usaopen
punctuacted_whoopen 0.0009990 0.5511805 0.0012844 punctuacted_whoopen
punctuacted_usaclose 0.0009990 0.5606371 0.0012844 punctuacted_usaclose
punctuacted_whoclose 0.0009990 0.5713019 0.0012844 punctuacted_whoclose

Compare resulting R values

n1 <- nrow(HSI_df)
n2 <- nrow(HSI_df)

model_r_comparison_p <- data.frame()
higher_model <- data.frame()
comparison_name <- data.frame()

for (i in 1:nrow(mantel_res_HSI)){
  for (j in 1:nrow(mantel_res_HSI)){
  
  model_i <- mantel_res_HSI[i, "model"]
  model_j <- mantel_res_HSI[j, "model"]
  
  comparison_name[i, j] <- paste0(model_i, "_", model_j)
  
  r_i <- mantel_res_HSI[i, "r"]
  r_j <- mantel_res_HSI[j, "r"]
  
  result <- compare_correlations(r_i,
                                 r_j,
                                 alpha,
                                 n1,
                                 n2)
  model_r_comparison_p[i, j] <- result$p_value
  higher_model[i, j] <- ifelse(r_i > r_j, 
                         "Yes", 
                         "No")

  }}


mat_r <- as.matrix(higher_model)
higher_r <- mat_r[lower.tri(mat_r)]

mat_p <- as.matrix(model_r_comparison_p)
p_values <- mat_p[lower.tri(mat_p)]

mat_name <- as.matrix(comparison_name)
comp_names <- mat_name[lower.tri(mat_name)]

corr_p_values <- p.adjust(p_values, method = "fdr")
met_significance <- ifelse(corr_p_values < alpha, "Yes", "No")

# build symmetric matrix of corrected p-values for plotting
corr_p_matrix <- matrix(0, nrow(mantel_res_HSI),
                        nrow(mantel_res_HSI))


corr_p_matrix[lower.tri(corr_p_matrix)] <- corr_p_values
corr_p_matrix[upper.tri(corr_p_matrix)] <-
  t(corr_p_matrix)[upper.tri(corr_p_matrix)]
diag(corr_p_matrix) <- diag(mat_p)

rownames(corr_p_matrix) <- mantel_res_HSI$model
colnames(corr_p_matrix) <- mantel_res_HSI$model

print(paste0("Is my matrix symmetric: ", isSymmetric(corr_p_matrix)))
## [1] "Is my matrix symmetric: TRUE"
# create binary matrix of whether p < alpha
binary_sig <- ifelse(corr_p_matrix < alpha, 0, 1)
rownames(binary_sig) <- mantel_res_HSI$model
colnames(binary_sig) <- mantel_res_HSI$model

if (isSymmetric(corr_p_matrix)){
  melted_mat <- melt(corr_p_matrix)
  
  plot_p <- ggplot(data = melted_mat, aes(x = Var1, 
                                           y = Var2, 
                                           fill = as.numeric(value))) +
                  geom_tile() +
                  scale_fill_gradient2(low = "lightblue", 
                                       high = "blue", 
                                       mid = "cornflowerblue", 
                                       midpoint = 0.25, limit = c(0, 0.5),
                                       space = "Lab", 
                                       name="P-values") +
                  theme_minimal() +
                  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                                   size = 8, hjust = 1)) +
                  labs(title = "P-values for each comparison",
                       x = NULL,
                       y = NULL) +
                  coord_fixed()
  print(plot_p)
  ggsave(file.path(plotpath, "stats_plot_HSI.png"), dpi = 600)
}else{
  print("Matrix is not symmetric, I can't plot it. Go back and check your matrix again!")
}

## Saving 7 x 5 in image
# print which comparisons had significantly higher mantel R's

# take the last row
HSI_row <- binary_sig[nrow(binary_sig),]
HSI_row <- data.frame(HSI_row)
HSI_high_names <- rownames(HSI_row)[HSI_row == 1]

message <- paste("The comparisons with the highest R are, in order of least to highest: ",
                 paste(HSI_high_names, collapse = ", "))
print(message)
## [1] "The comparisons with the highest R are, in order of least to highest:  punctuated_nn_usaopen, punctuated_nn_whoopen, punctuated_nn_usaclose, punctuated_nn_whoclose, punctuacted_usaopen, punctuacted_whoopen, punctuacted_usaclose, punctuacted_whoclose"
HSI_comparisons <- data.frame("comparison" = comp_names,
                              "was_r_higher" = higher_r,
                              "raw_p" = p_values,
                              "corr_p" = corr_p_values,
                              "met_significance" = met_significance)

HSI_comparisons %>% 
  knitr::kable(format = "html") %>% 
  kable_styling()
comparison was_r_higher raw_p corr_p met_significance
behave_divopen_behave_divclose Yes 0.4698 0.4791960 No
behave_convopen_behave_divclose Yes 0.3049 0.3588438 No
behave_convclose_behave_divclose Yes 0.2430 0.3098250 No
punctuacted_chinaopen_behave_divclose Yes 2e-04 0.0005885 Yes
punctuacted_chinaclose_behave_divclose Yes 1e-04 0.0003060 Yes
behave_nnopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_divclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divclose Yes 0.0000 0.0000000 Yes
behave_convopen_behave_divopen Yes 0.3320 0.3848182 No
behave_convclose_behave_divopen Yes 0.2674 0.3247000 No
punctuacted_chinaopen_behave_divopen Yes 2e-04 0.0005885 Yes
punctuacted_chinaclose_behave_divopen Yes 1e-04 0.0003060 Yes
behave_nnopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_divopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_divopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_divopen Yes 0.0000 0.0000000 Yes
behave_convclose_behave_convopen Yes 0.4261 0.4465295 No
punctuacted_chinaopen_behave_convopen Yes 0.0010 0.0025932 Yes
punctuacted_chinaclose_behave_convopen Yes 5e-04 0.0014167 Yes
behave_nnopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaopen_behave_convopen Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convopen Yes 0.0000 0.0000000 Yes
punctuacted_chinaopen_behave_convclose Yes 0.0018 0.0044419 Yes
punctuacted_chinaclose_behave_convclose Yes 9e-04 0.0024158 Yes
behave_nnopen_behave_convclose Yes 1e-04 0.0003060 Yes
punctuated_nn_chinaopen_behave_convclose Yes 0.0000 0.0000000 Yes
behave_nnclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_chinaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuated_nn_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoopen_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_usaclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_whoclose_behave_convclose Yes 0.0000 0.0000000 Yes
punctuacted_chinaclose_punctuacted_chinaopen Yes 0.4142 0.4370524 No
behave_nnopen_punctuacted_chinaopen Yes 0.2115 0.2719286 No
punctuated_nn_chinaopen_punctuacted_chinaopen Yes 0.1441 0.2060495 No
behave_nnclose_punctuacted_chinaopen Yes 0.1379 0.2009400 No
punctuated_nn_chinaclose_punctuacted_chinaopen Yes 0.0826 0.1330295 No
punctuated_nn_usaopen_punctuacted_chinaopen Yes 0.0451 0.0793138 No
punctuated_nn_whoopen_punctuacted_chinaopen Yes 0.0426 0.0775929 No
punctuated_nn_usaclose_punctuacted_chinaopen Yes 0.0221 0.0444908 Yes
punctuated_nn_whoclose_punctuacted_chinaopen Yes 0.0206 0.0431753 Yes
punctuacted_usaopen_punctuacted_chinaopen Yes 0.0017 0.0042639 Yes
punctuacted_whoopen_punctuacted_chinaopen Yes 0.0010 0.0025932 Yes
punctuacted_usaclose_punctuacted_chinaopen Yes 6e-04 0.0016691 Yes
punctuacted_whoclose_punctuacted_chinaopen Yes 3e-04 0.0008660 Yes
behave_nnopen_punctuacted_chinaclose Yes 0.2794 0.3313814 No
punctuated_nn_chinaopen_punctuacted_chinaclose Yes 0.1989 0.2578958 No
behave_nnclose_punctuacted_chinaclose Yes 0.1913 0.2501615 No
punctuated_nn_chinaclose_punctuacted_chinaclose Yes 0.1208 0.1777154 No
punctuated_nn_usaopen_punctuacted_chinaclose Yes 0.0697 0.1159141 No
punctuated_nn_whoopen_punctuacted_chinaclose Yes 0.0663 0.1114714 No
punctuated_nn_usaclose_punctuacted_chinaclose Yes 0.0363 0.0677305 No
punctuated_nn_whoclose_punctuacted_chinaclose Yes 0.0340 0.0642222 No
punctuacted_usaopen_punctuacted_chinaclose Yes 0.0033 0.0078891 Yes
punctuacted_whoopen_punctuacted_chinaclose Yes 0.0020 0.0048571 Yes
punctuacted_usaclose_punctuacted_chinaclose Yes 0.0012 0.0030600 Yes
punctuacted_whoclose_punctuacted_chinaclose Yes 7e-04 0.0019125 Yes
punctuated_nn_chinaopen_behave_nnopen Yes 0.3971 0.4219188 No
behave_nnclose_behave_nnopen Yes 0.3865 0.4135280 No
punctuated_nn_chinaclose_behave_nnopen Yes 0.2789 0.3313814 No
punctuated_nn_usaopen_behave_nnopen Yes 0.1858 0.2462509 No
punctuated_nn_whoopen_behave_nnopen Yes 0.1789 0.2401026 No
punctuated_nn_usaclose_behave_nnopen Yes 0.1130 0.1695000 No
punctuated_nn_whoclose_behave_nnopen Yes 0.1074 0.1666170 No
punctuacted_usaopen_behave_nnopen Yes 0.0165 0.0350625 Yes
punctuacted_whoopen_behave_nnopen Yes 0.0110 0.0243913 Yes
punctuacted_usaclose_behave_nnopen Yes 0.0073 0.0169227 Yes
punctuacted_whoclose_behave_nnopen Yes 0.0044 0.0103569 Yes
behave_nnclose_punctuated_nn_chinaopen Yes 0.4890 0.4895000 No
punctuated_nn_chinaclose_punctuated_nn_chinaopen Yes 0.3724 0.4135280 No
punctuated_nn_usaopen_punctuated_nn_chinaopen Yes 0.2635 0.3247000 No
punctuated_nn_whoopen_punctuated_nn_chinaopen Yes 0.2550 0.3215508 No
punctuated_nn_usaclose_punctuated_nn_chinaopen Yes 0.1711 0.2358405 No
punctuated_nn_whoclose_punctuated_nn_chinaopen Yes 0.1636 0.2296404 No
punctuacted_usaopen_punctuated_nn_chinaopen Yes 0.0307 0.0602192 No
punctuacted_whoopen_punctuated_nn_chinaopen Yes 0.0212 0.0432480 Yes
punctuacted_usaclose_punctuated_nn_chinaopen Yes 0.0146 0.0319114 Yes
punctuacted_whoclose_punctuated_nn_chinaopen Yes 0.0092 0.0210090 Yes
punctuated_nn_chinaclose_behave_nnclose Yes 0.3830 0.4135280 No
punctuated_nn_usaopen_behave_nnclose Yes 0.2726 0.3284079 No
punctuated_nn_whoopen_behave_nnclose Yes 0.2640 0.3247000 No
punctuated_nn_usaclose_behave_nnclose Yes 0.1782 0.2401026 No
punctuated_nn_whoclose_behave_nnclose Yes 0.1705 0.2358405 No
punctuacted_usaopen_behave_nnclose Yes 0.0327 0.0625388 No
punctuacted_whoopen_behave_nnclose Yes 0.0226 0.0449065 Yes
punctuacted_usaclose_behave_nnclose Yes 0.0156 0.0336169 Yes
punctuacted_whoclose_behave_nnclose Yes 0.0099 0.0222750 Yes
punctuated_nn_usaopen_punctuated_nn_chinaclose Yes 0.3794 0.4135280 No
punctuated_nn_whoopen_punctuated_nn_chinaclose Yes 0.3694 0.4135280 No
punctuated_nn_usaclose_punctuated_nn_chinaclose Yes 0.2662 0.3247000 No
punctuated_nn_whoclose_punctuated_nn_chinaclose Yes 0.2564 0.3215508 No
punctuacted_usaopen_punctuated_nn_chinaclose Yes 0.0612 0.1052090 No
punctuacted_whoopen_punctuated_nn_chinaclose Yes 0.0441 0.0793138 No
punctuacted_usaclose_punctuated_nn_chinaclose Yes 0.0317 0.0613937 No
punctuacted_whoclose_punctuated_nn_chinaclose Yes 0.0211 0.0432480 Yes
punctuated_nn_whoopen_punctuated_nn_usaopen Yes 0.4895 0.4895000 No
punctuated_nn_usaclose_punctuated_nn_usaopen Yes 0.3755 0.4135280 No
punctuated_nn_whoclose_punctuated_nn_usaopen Yes 0.3641 0.4135280 No
punctuacted_usaopen_punctuated_nn_usaopen Yes 0.1079 0.1666170 No
punctuacted_whoopen_punctuated_nn_usaopen Yes 0.0811 0.1320032 No
punctuacted_usaclose_punctuated_nn_usaopen Yes 0.0606 0.1052090 No
punctuacted_whoclose_punctuated_nn_usaopen Yes 0.0424 0.0775929 No
punctuated_nn_usaclose_punctuated_nn_whoopen Yes 0.3855 0.4135280 No
punctuated_nn_whoclose_punctuated_nn_whoopen Yes 0.3741 0.4135280 No
punctuacted_usaopen_punctuated_nn_whoopen Yes 0.1129 0.1695000 No
punctuacted_whoopen_punctuated_nn_whoopen Yes 0.0851 0.1342299 No
punctuacted_usaclose_punctuated_nn_whoopen Yes 0.0639 0.1086300 No
punctuacted_whoclose_punctuated_nn_whoopen Yes 0.0448 0.0793138 No
punctuated_nn_whoclose_punctuated_nn_usaclose Yes 0.4880 0.4895000 No
punctuacted_usaopen_punctuated_nn_usaclose Yes 0.1787 0.2401026 No
punctuacted_whoopen_punctuated_nn_usaclose Yes 0.1400 0.2020755 No
punctuacted_usaclose_punctuated_nn_usaclose Yes 0.1089 0.1666170 No
punctuacted_whoclose_punctuated_nn_usaclose Yes 0.0798 0.1312839 No
punctuacted_usaopen_punctuated_nn_whoclose Yes 0.1867 0.2462509 No
punctuacted_whoopen_punctuated_nn_whoclose Yes 0.1468 0.2079667 No
punctuacted_usaclose_punctuated_nn_whoclose Yes 0.1147 0.1703796 No
punctuacted_whoclose_punctuated_nn_whoclose Yes 0.0844 0.1342299 No
punctuacted_whoopen_punctuacted_usaopen Yes 0.4364 0.4511432 No
punctuacted_usaclose_punctuacted_usaopen Yes 0.3776 0.4135280 No
punctuacted_whoclose_punctuacted_usaopen Yes 0.3135 0.3661489 No
punctuacted_usaclose_punctuacted_whoopen Yes 0.4397 0.4515040 No
punctuacted_whoclose_punctuacted_whoopen Yes 0.3723 0.4135280 No
punctuacted_whoclose_punctuacted_usaclose Yes 0.4309 0.4484878 No
import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/FTSE/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize = 20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()

import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/GSPC/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize =20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()

import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/GDAXI/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize =20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()

import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/FTSEMIB/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize =20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()

import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/FCHI/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize =20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()

import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/AXJO/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize =20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()

import numpy as np
import pandas as pd
import seaborn as sns
import glob
import os

import matplotlib.pyplot as plt
from matplotlib.pyplot import figure

path = "/Users/scrockford/Library/CloudStorage/OneDrive-FondazioneIstitutoItalianoTecnologia/punctuated_similarity_proof/results/HSI/*.csv"

cmap = 'mako'

for fname in glob.glob(path):

  data2plot = pd.read_csv(fname)
  plotname = os.path.basename(fname)
  plotname = plotname.replace(".csv", "")

  plt.figure()
  plt.title(plotname, fontsize =20)
  sns.heatmap(data2plot,
              cmap = cmap,
              square=True,
              cbar=True,
              xticklabels=False,
              yticklabels=False)

  plt.show()